{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-} -- Generated code. {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE ForeignFunctionInterface, ConstraintKinds, TypeFamilies, MultiParamTypeClasses, KindSignatures, FlexibleInstances, UndecidableInstances, DataKinds, OverloadedStrings, NegativeLiterals, FlexibleContexts #-} module GI.GioAttributes where import Prelude () import Data.GI.Base.ShortPrelude import Data.Char import Data.Int import Data.Word import qualified Data.ByteString.Char8 as B import Data.ByteString.Char8 (ByteString) import qualified Data.Map as Map import Foreign.C import Foreign.Ptr import Foreign.ForeignPtr import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Storable (peek, poke, sizeOf) import Control.Applicative ((<$>)) import Control.Exception (onException) import Control.Monad.IO.Class import qualified Data.Text as T import Data.GI.Base.Attributes hiding (get, set) import Data.GI.Base.BasicTypes import Data.GI.Base.BasicConversions import Data.GI.Base.Closure import Data.GI.Base.GError import Data.GI.Base.GHashTable import Data.GI.Base.GParamSpec import Data.GI.Base.GVariant import Data.GI.Base.GValue import Data.GI.Base.ManagedPtr import Data.GI.Base.Overloading import Data.GI.Base.Properties hiding (new) import Data.GI.Base.Signals (SignalConnectMode(..), connectSignalFunPtr, SignalHandlerId) import Data.GI.Base.Utils import qualified GI.GLib as GLib import qualified GI.GLibAttributes as GLibA import qualified GI.GObject as GObject import qualified GI.GObjectAttributes as GObjectA import GI.Gio -- VVV Prop "enabled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getActionEnabled :: (MonadIO m, ActionK o) => o -> m Bool getActionEnabled obj = liftIO $ getObjectPropertyBool obj "enabled" data ActionEnabledPropertyInfo instance AttrInfo ActionEnabledPropertyInfo where type AttrAllowedOps ActionEnabledPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ActionEnabledPropertyInfo = (~) () type AttrBaseTypeConstraint ActionEnabledPropertyInfo = ActionK type AttrGetType ActionEnabledPropertyInfo = Bool type AttrLabel ActionEnabledPropertyInfo = "Action::enabled" attrGet _ = getActionEnabled attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getActionName :: (MonadIO m, ActionK o) => o -> m T.Text getActionName obj = liftIO $ getObjectPropertyString obj "name" data ActionNamePropertyInfo instance AttrInfo ActionNamePropertyInfo where type AttrAllowedOps ActionNamePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ActionNamePropertyInfo = (~) () type AttrBaseTypeConstraint ActionNamePropertyInfo = ActionK type AttrGetType ActionNamePropertyInfo = T.Text type AttrLabel ActionNamePropertyInfo = "Action::name" attrGet _ = getActionName attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "parameter-type" -- Type: TInterface "GLib" "VariantType" -- Flags: [PropertyReadable] getActionParameterType :: (MonadIO m, ActionK o) => o -> m GLib.VariantType getActionParameterType obj = liftIO $ getObjectPropertyBoxed obj "parameter-type" GLib.VariantType data ActionParameterTypePropertyInfo instance AttrInfo ActionParameterTypePropertyInfo where type AttrAllowedOps ActionParameterTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ActionParameterTypePropertyInfo = (~) () type AttrBaseTypeConstraint ActionParameterTypePropertyInfo = ActionK type AttrGetType ActionParameterTypePropertyInfo = GLib.VariantType type AttrLabel ActionParameterTypePropertyInfo = "Action::parameter-type" attrGet _ = getActionParameterType attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "state" -- Type: TVariant -- Flags: [PropertyReadable] getActionState :: (MonadIO m, ActionK o) => o -> m GVariant getActionState obj = liftIO $ getObjectPropertyVariant obj "state" data ActionStatePropertyInfo instance AttrInfo ActionStatePropertyInfo where type AttrAllowedOps ActionStatePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ActionStatePropertyInfo = (~) () type AttrBaseTypeConstraint ActionStatePropertyInfo = ActionK type AttrGetType ActionStatePropertyInfo = GVariant type AttrLabel ActionStatePropertyInfo = "Action::state" attrGet _ = getActionState attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "state-type" -- Type: TInterface "GLib" "VariantType" -- Flags: [PropertyReadable] getActionStateType :: (MonadIO m, ActionK o) => o -> m GLib.VariantType getActionStateType obj = liftIO $ getObjectPropertyBoxed obj "state-type" GLib.VariantType data ActionStateTypePropertyInfo instance AttrInfo ActionStateTypePropertyInfo where type AttrAllowedOps ActionStateTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ActionStateTypePropertyInfo = (~) () type AttrBaseTypeConstraint ActionStateTypePropertyInfo = ActionK type AttrGetType ActionStateTypePropertyInfo = GLib.VariantType type AttrLabel ActionStateTypePropertyInfo = "Action::state-type" attrGet _ = getActionStateType attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList Action = '[ '("enabled", ActionEnabledPropertyInfo), '("name", ActionNamePropertyInfo), '("parameter-type", ActionParameterTypePropertyInfo), '("state", ActionStatePropertyInfo), '("state-type", ActionStateTypePropertyInfo)] type instance AttributeList ActionGroup = '[ ] type instance AttributeList ActionMap = '[ ] type instance AttributeList AppInfo = '[ ] type instance AttributeList AppInfoMonitor = '[ ] type instance AttributeList AppLaunchContext = '[ ] -- VVV Prop "action-group" -- Type: TInterface "Gio" "ActionGroup" -- Flags: [PropertyWritable] setApplicationActionGroup :: (MonadIO m, ApplicationK o, ActionGroupK a) => o -> a -> m () setApplicationActionGroup obj val = liftIO $ setObjectPropertyObject obj "action-group" val constructApplicationActionGroup :: (ActionGroupK a) => a -> IO ([Char], GValue) constructApplicationActionGroup val = constructObjectPropertyObject "action-group" val data ApplicationActionGroupPropertyInfo instance AttrInfo ApplicationActionGroupPropertyInfo where type AttrAllowedOps ApplicationActionGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct] type AttrSetTypeConstraint ApplicationActionGroupPropertyInfo = ActionGroupK type AttrBaseTypeConstraint ApplicationActionGroupPropertyInfo = ApplicationK type AttrGetType ApplicationActionGroupPropertyInfo = () type AttrLabel ApplicationActionGroupPropertyInfo = "Application::action-group" attrGet _ = undefined attrSet _ = setApplicationActionGroup attrConstruct _ = constructApplicationActionGroup -- VVV Prop "application-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getApplicationApplicationId :: (MonadIO m, ApplicationK o) => o -> m T.Text getApplicationApplicationId obj = liftIO $ getObjectPropertyString obj "application-id" setApplicationApplicationId :: (MonadIO m, ApplicationK o) => o -> T.Text -> m () setApplicationApplicationId obj val = liftIO $ setObjectPropertyString obj "application-id" val constructApplicationApplicationId :: T.Text -> IO ([Char], GValue) constructApplicationApplicationId val = constructObjectPropertyString "application-id" val data ApplicationApplicationIdPropertyInfo instance AttrInfo ApplicationApplicationIdPropertyInfo where type AttrAllowedOps ApplicationApplicationIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationApplicationIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ApplicationApplicationIdPropertyInfo = ApplicationK type AttrGetType ApplicationApplicationIdPropertyInfo = T.Text type AttrLabel ApplicationApplicationIdPropertyInfo = "Application::application-id" attrGet _ = getApplicationApplicationId attrSet _ = setApplicationApplicationId attrConstruct _ = constructApplicationApplicationId -- VVV Prop "flags" -- Type: TInterface "Gio" "ApplicationFlags" -- Flags: [PropertyReadable,PropertyWritable] getApplicationFlags :: (MonadIO m, ApplicationK o) => o -> m [ApplicationFlags] getApplicationFlags obj = liftIO $ getObjectPropertyFlags obj "flags" setApplicationFlags :: (MonadIO m, ApplicationK o) => o -> [ApplicationFlags] -> m () setApplicationFlags obj val = liftIO $ setObjectPropertyFlags obj "flags" val constructApplicationFlags :: [ApplicationFlags] -> IO ([Char], GValue) constructApplicationFlags val = constructObjectPropertyFlags "flags" val data ApplicationFlagsPropertyInfo instance AttrInfo ApplicationFlagsPropertyInfo where type AttrAllowedOps ApplicationFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationFlagsPropertyInfo = (~) [ApplicationFlags] type AttrBaseTypeConstraint ApplicationFlagsPropertyInfo = ApplicationK type AttrGetType ApplicationFlagsPropertyInfo = [ApplicationFlags] type AttrLabel ApplicationFlagsPropertyInfo = "Application::flags" attrGet _ = getApplicationFlags attrSet _ = setApplicationFlags attrConstruct _ = constructApplicationFlags -- VVV Prop "inactivity-timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getApplicationInactivityTimeout :: (MonadIO m, ApplicationK o) => o -> m Word32 getApplicationInactivityTimeout obj = liftIO $ getObjectPropertyCUInt obj "inactivity-timeout" setApplicationInactivityTimeout :: (MonadIO m, ApplicationK o) => o -> Word32 -> m () setApplicationInactivityTimeout obj val = liftIO $ setObjectPropertyCUInt obj "inactivity-timeout" val constructApplicationInactivityTimeout :: Word32 -> IO ([Char], GValue) constructApplicationInactivityTimeout val = constructObjectPropertyCUInt "inactivity-timeout" val data ApplicationInactivityTimeoutPropertyInfo instance AttrInfo ApplicationInactivityTimeoutPropertyInfo where type AttrAllowedOps ApplicationInactivityTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationInactivityTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ApplicationInactivityTimeoutPropertyInfo = ApplicationK type AttrGetType ApplicationInactivityTimeoutPropertyInfo = Word32 type AttrLabel ApplicationInactivityTimeoutPropertyInfo = "Application::inactivity-timeout" attrGet _ = getApplicationInactivityTimeout attrSet _ = setApplicationInactivityTimeout attrConstruct _ = constructApplicationInactivityTimeout -- VVV Prop "is-busy" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getApplicationIsBusy :: (MonadIO m, ApplicationK o) => o -> m Bool getApplicationIsBusy obj = liftIO $ getObjectPropertyBool obj "is-busy" data ApplicationIsBusyPropertyInfo instance AttrInfo ApplicationIsBusyPropertyInfo where type AttrAllowedOps ApplicationIsBusyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ApplicationIsBusyPropertyInfo = (~) () type AttrBaseTypeConstraint ApplicationIsBusyPropertyInfo = ApplicationK type AttrGetType ApplicationIsBusyPropertyInfo = Bool type AttrLabel ApplicationIsBusyPropertyInfo = "Application::is-busy" attrGet _ = getApplicationIsBusy attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-registered" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getApplicationIsRegistered :: (MonadIO m, ApplicationK o) => o -> m Bool getApplicationIsRegistered obj = liftIO $ getObjectPropertyBool obj "is-registered" data ApplicationIsRegisteredPropertyInfo instance AttrInfo ApplicationIsRegisteredPropertyInfo where type AttrAllowedOps ApplicationIsRegisteredPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ApplicationIsRegisteredPropertyInfo = (~) () type AttrBaseTypeConstraint ApplicationIsRegisteredPropertyInfo = ApplicationK type AttrGetType ApplicationIsRegisteredPropertyInfo = Bool type AttrLabel ApplicationIsRegisteredPropertyInfo = "Application::is-registered" attrGet _ = getApplicationIsRegistered attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-remote" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getApplicationIsRemote :: (MonadIO m, ApplicationK o) => o -> m Bool getApplicationIsRemote obj = liftIO $ getObjectPropertyBool obj "is-remote" data ApplicationIsRemotePropertyInfo instance AttrInfo ApplicationIsRemotePropertyInfo where type AttrAllowedOps ApplicationIsRemotePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ApplicationIsRemotePropertyInfo = (~) () type AttrBaseTypeConstraint ApplicationIsRemotePropertyInfo = ApplicationK type AttrGetType ApplicationIsRemotePropertyInfo = Bool type AttrLabel ApplicationIsRemotePropertyInfo = "Application::is-remote" attrGet _ = getApplicationIsRemote attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "resource-base-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getApplicationResourceBasePath :: (MonadIO m, ApplicationK o) => o -> m T.Text getApplicationResourceBasePath obj = liftIO $ getObjectPropertyString obj "resource-base-path" setApplicationResourceBasePath :: (MonadIO m, ApplicationK o) => o -> T.Text -> m () setApplicationResourceBasePath obj val = liftIO $ setObjectPropertyString obj "resource-base-path" val constructApplicationResourceBasePath :: T.Text -> IO ([Char], GValue) constructApplicationResourceBasePath val = constructObjectPropertyString "resource-base-path" val data ApplicationResourceBasePathPropertyInfo instance AttrInfo ApplicationResourceBasePathPropertyInfo where type AttrAllowedOps ApplicationResourceBasePathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ApplicationResourceBasePathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ApplicationResourceBasePathPropertyInfo = ApplicationK type AttrGetType ApplicationResourceBasePathPropertyInfo = T.Text type AttrLabel ApplicationResourceBasePathPropertyInfo = "Application::resource-base-path" attrGet _ = getApplicationResourceBasePath attrSet _ = setApplicationResourceBasePath attrConstruct _ = constructApplicationResourceBasePath type instance AttributeList Application = '[ '("action-group", ApplicationActionGroupPropertyInfo), '("application-id", ApplicationApplicationIdPropertyInfo), '("flags", ApplicationFlagsPropertyInfo), '("inactivity-timeout", ApplicationInactivityTimeoutPropertyInfo), '("is-busy", ApplicationIsBusyPropertyInfo), '("is-registered", ApplicationIsRegisteredPropertyInfo), '("is-remote", ApplicationIsRemotePropertyInfo), '("resource-base-path", ApplicationResourceBasePathPropertyInfo)] -- VVV Prop "arguments" -- Type: TVariant -- Flags: [PropertyWritable,PropertyConstructOnly] constructApplicationCommandLineArguments :: GVariant -> IO ([Char], GValue) constructApplicationCommandLineArguments val = constructObjectPropertyVariant "arguments" val data ApplicationCommandLineArgumentsPropertyInfo instance AttrInfo ApplicationCommandLineArgumentsPropertyInfo where type AttrAllowedOps ApplicationCommandLineArgumentsPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint ApplicationCommandLineArgumentsPropertyInfo = (~) GVariant type AttrBaseTypeConstraint ApplicationCommandLineArgumentsPropertyInfo = ApplicationCommandLineK type AttrGetType ApplicationCommandLineArgumentsPropertyInfo = () type AttrLabel ApplicationCommandLineArgumentsPropertyInfo = "ApplicationCommandLine::arguments" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructApplicationCommandLineArguments -- VVV Prop "is-remote" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getApplicationCommandLineIsRemote :: (MonadIO m, ApplicationCommandLineK o) => o -> m Bool getApplicationCommandLineIsRemote obj = liftIO $ getObjectPropertyBool obj "is-remote" data ApplicationCommandLineIsRemotePropertyInfo instance AttrInfo ApplicationCommandLineIsRemotePropertyInfo where type AttrAllowedOps ApplicationCommandLineIsRemotePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ApplicationCommandLineIsRemotePropertyInfo = (~) () type AttrBaseTypeConstraint ApplicationCommandLineIsRemotePropertyInfo = ApplicationCommandLineK type AttrGetType ApplicationCommandLineIsRemotePropertyInfo = Bool type AttrLabel ApplicationCommandLineIsRemotePropertyInfo = "ApplicationCommandLine::is-remote" attrGet _ = getApplicationCommandLineIsRemote attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "options" -- Type: TVariant -- Flags: [PropertyWritable,PropertyConstructOnly] constructApplicationCommandLineOptions :: GVariant -> IO ([Char], GValue) constructApplicationCommandLineOptions val = constructObjectPropertyVariant "options" val data ApplicationCommandLineOptionsPropertyInfo instance AttrInfo ApplicationCommandLineOptionsPropertyInfo where type AttrAllowedOps ApplicationCommandLineOptionsPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint ApplicationCommandLineOptionsPropertyInfo = (~) GVariant type AttrBaseTypeConstraint ApplicationCommandLineOptionsPropertyInfo = ApplicationCommandLineK type AttrGetType ApplicationCommandLineOptionsPropertyInfo = () type AttrLabel ApplicationCommandLineOptionsPropertyInfo = "ApplicationCommandLine::options" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructApplicationCommandLineOptions -- VVV Prop "platform-data" -- Type: TVariant -- Flags: [PropertyWritable,PropertyConstructOnly] constructApplicationCommandLinePlatformData :: GVariant -> IO ([Char], GValue) constructApplicationCommandLinePlatformData val = constructObjectPropertyVariant "platform-data" val data ApplicationCommandLinePlatformDataPropertyInfo instance AttrInfo ApplicationCommandLinePlatformDataPropertyInfo where type AttrAllowedOps ApplicationCommandLinePlatformDataPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint ApplicationCommandLinePlatformDataPropertyInfo = (~) GVariant type AttrBaseTypeConstraint ApplicationCommandLinePlatformDataPropertyInfo = ApplicationCommandLineK type AttrGetType ApplicationCommandLinePlatformDataPropertyInfo = () type AttrLabel ApplicationCommandLinePlatformDataPropertyInfo = "ApplicationCommandLine::platform-data" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructApplicationCommandLinePlatformData type instance AttributeList ApplicationCommandLine = '[ '("arguments", ApplicationCommandLineArgumentsPropertyInfo), '("is-remote", ApplicationCommandLineIsRemotePropertyInfo), '("options", ApplicationCommandLineOptionsPropertyInfo), '("platform-data", ApplicationCommandLinePlatformDataPropertyInfo)] type instance AttributeList AsyncInitable = '[ ] type instance AttributeList AsyncResult = '[ ] -- VVV Prop "buffer-size" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getBufferedInputStreamBufferSize :: (MonadIO m, BufferedInputStreamK o) => o -> m Word32 getBufferedInputStreamBufferSize obj = liftIO $ getObjectPropertyCUInt obj "buffer-size" setBufferedInputStreamBufferSize :: (MonadIO m, BufferedInputStreamK o) => o -> Word32 -> m () setBufferedInputStreamBufferSize obj val = liftIO $ setObjectPropertyCUInt obj "buffer-size" val constructBufferedInputStreamBufferSize :: Word32 -> IO ([Char], GValue) constructBufferedInputStreamBufferSize val = constructObjectPropertyCUInt "buffer-size" val data BufferedInputStreamBufferSizePropertyInfo instance AttrInfo BufferedInputStreamBufferSizePropertyInfo where type AttrAllowedOps BufferedInputStreamBufferSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BufferedInputStreamBufferSizePropertyInfo = (~) Word32 type AttrBaseTypeConstraint BufferedInputStreamBufferSizePropertyInfo = BufferedInputStreamK type AttrGetType BufferedInputStreamBufferSizePropertyInfo = Word32 type AttrLabel BufferedInputStreamBufferSizePropertyInfo = "BufferedInputStream::buffer-size" attrGet _ = getBufferedInputStreamBufferSize attrSet _ = setBufferedInputStreamBufferSize attrConstruct _ = constructBufferedInputStreamBufferSize type instance AttributeList BufferedInputStream = '[ '("base-stream", FilterInputStreamBaseStreamPropertyInfo), '("buffer-size", BufferedInputStreamBufferSizePropertyInfo), '("close-base-stream", FilterInputStreamCloseBaseStreamPropertyInfo)] -- VVV Prop "auto-grow" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getBufferedOutputStreamAutoGrow :: (MonadIO m, BufferedOutputStreamK o) => o -> m Bool getBufferedOutputStreamAutoGrow obj = liftIO $ getObjectPropertyBool obj "auto-grow" setBufferedOutputStreamAutoGrow :: (MonadIO m, BufferedOutputStreamK o) => o -> Bool -> m () setBufferedOutputStreamAutoGrow obj val = liftIO $ setObjectPropertyBool obj "auto-grow" val constructBufferedOutputStreamAutoGrow :: Bool -> IO ([Char], GValue) constructBufferedOutputStreamAutoGrow val = constructObjectPropertyBool "auto-grow" val data BufferedOutputStreamAutoGrowPropertyInfo instance AttrInfo BufferedOutputStreamAutoGrowPropertyInfo where type AttrAllowedOps BufferedOutputStreamAutoGrowPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BufferedOutputStreamAutoGrowPropertyInfo = (~) Bool type AttrBaseTypeConstraint BufferedOutputStreamAutoGrowPropertyInfo = BufferedOutputStreamK type AttrGetType BufferedOutputStreamAutoGrowPropertyInfo = Bool type AttrLabel BufferedOutputStreamAutoGrowPropertyInfo = "BufferedOutputStream::auto-grow" attrGet _ = getBufferedOutputStreamAutoGrow attrSet _ = setBufferedOutputStreamAutoGrow attrConstruct _ = constructBufferedOutputStreamAutoGrow -- VVV Prop "buffer-size" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getBufferedOutputStreamBufferSize :: (MonadIO m, BufferedOutputStreamK o) => o -> m Word32 getBufferedOutputStreamBufferSize obj = liftIO $ getObjectPropertyCUInt obj "buffer-size" setBufferedOutputStreamBufferSize :: (MonadIO m, BufferedOutputStreamK o) => o -> Word32 -> m () setBufferedOutputStreamBufferSize obj val = liftIO $ setObjectPropertyCUInt obj "buffer-size" val constructBufferedOutputStreamBufferSize :: Word32 -> IO ([Char], GValue) constructBufferedOutputStreamBufferSize val = constructObjectPropertyCUInt "buffer-size" val data BufferedOutputStreamBufferSizePropertyInfo instance AttrInfo BufferedOutputStreamBufferSizePropertyInfo where type AttrAllowedOps BufferedOutputStreamBufferSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BufferedOutputStreamBufferSizePropertyInfo = (~) Word32 type AttrBaseTypeConstraint BufferedOutputStreamBufferSizePropertyInfo = BufferedOutputStreamK type AttrGetType BufferedOutputStreamBufferSizePropertyInfo = Word32 type AttrLabel BufferedOutputStreamBufferSizePropertyInfo = "BufferedOutputStream::buffer-size" attrGet _ = getBufferedOutputStreamBufferSize attrSet _ = setBufferedOutputStreamBufferSize attrConstruct _ = constructBufferedOutputStreamBufferSize type instance AttributeList BufferedOutputStream = '[ '("auto-grow", BufferedOutputStreamAutoGrowPropertyInfo), '("base-stream", FilterOutputStreamBaseStreamPropertyInfo), '("buffer-size", BufferedOutputStreamBufferSizePropertyInfo), '("close-base-stream", FilterOutputStreamCloseBaseStreamPropertyInfo)] -- VVV Prop "bytes" -- Type: TInterface "GLib" "Bytes" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getBytesIconBytes :: (MonadIO m, BytesIconK o) => o -> m GLib.Bytes getBytesIconBytes obj = liftIO $ getObjectPropertyBoxed obj "bytes" GLib.Bytes constructBytesIconBytes :: GLib.Bytes -> IO ([Char], GValue) constructBytesIconBytes val = constructObjectPropertyBoxed "bytes" val data BytesIconBytesPropertyInfo instance AttrInfo BytesIconBytesPropertyInfo where type AttrAllowedOps BytesIconBytesPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint BytesIconBytesPropertyInfo = (~) GLib.Bytes type AttrBaseTypeConstraint BytesIconBytesPropertyInfo = BytesIconK type AttrGetType BytesIconBytesPropertyInfo = GLib.Bytes type AttrLabel BytesIconBytesPropertyInfo = "BytesIcon::bytes" attrGet _ = getBytesIconBytes attrSet _ = undefined attrConstruct _ = constructBytesIconBytes type instance AttributeList BytesIcon = '[ '("bytes", BytesIconBytesPropertyInfo)] type instance AttributeList Cancellable = '[ ] -- VVV Prop "from-charset" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCharsetConverterFromCharset :: (MonadIO m, CharsetConverterK o) => o -> m T.Text getCharsetConverterFromCharset obj = liftIO $ getObjectPropertyString obj "from-charset" constructCharsetConverterFromCharset :: T.Text -> IO ([Char], GValue) constructCharsetConverterFromCharset val = constructObjectPropertyString "from-charset" val data CharsetConverterFromCharsetPropertyInfo instance AttrInfo CharsetConverterFromCharsetPropertyInfo where type AttrAllowedOps CharsetConverterFromCharsetPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CharsetConverterFromCharsetPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CharsetConverterFromCharsetPropertyInfo = CharsetConverterK type AttrGetType CharsetConverterFromCharsetPropertyInfo = T.Text type AttrLabel CharsetConverterFromCharsetPropertyInfo = "CharsetConverter::from-charset" attrGet _ = getCharsetConverterFromCharset attrSet _ = undefined attrConstruct _ = constructCharsetConverterFromCharset -- VVV Prop "to-charset" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getCharsetConverterToCharset :: (MonadIO m, CharsetConverterK o) => o -> m T.Text getCharsetConverterToCharset obj = liftIO $ getObjectPropertyString obj "to-charset" constructCharsetConverterToCharset :: T.Text -> IO ([Char], GValue) constructCharsetConverterToCharset val = constructObjectPropertyString "to-charset" val data CharsetConverterToCharsetPropertyInfo instance AttrInfo CharsetConverterToCharsetPropertyInfo where type AttrAllowedOps CharsetConverterToCharsetPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CharsetConverterToCharsetPropertyInfo = (~) T.Text type AttrBaseTypeConstraint CharsetConverterToCharsetPropertyInfo = CharsetConverterK type AttrGetType CharsetConverterToCharsetPropertyInfo = T.Text type AttrLabel CharsetConverterToCharsetPropertyInfo = "CharsetConverter::to-charset" attrGet _ = getCharsetConverterToCharset attrSet _ = undefined attrConstruct _ = constructCharsetConverterToCharset -- VVV Prop "use-fallback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getCharsetConverterUseFallback :: (MonadIO m, CharsetConverterK o) => o -> m Bool getCharsetConverterUseFallback obj = liftIO $ getObjectPropertyBool obj "use-fallback" setCharsetConverterUseFallback :: (MonadIO m, CharsetConverterK o) => o -> Bool -> m () setCharsetConverterUseFallback obj val = liftIO $ setObjectPropertyBool obj "use-fallback" val constructCharsetConverterUseFallback :: Bool -> IO ([Char], GValue) constructCharsetConverterUseFallback val = constructObjectPropertyBool "use-fallback" val data CharsetConverterUseFallbackPropertyInfo instance AttrInfo CharsetConverterUseFallbackPropertyInfo where type AttrAllowedOps CharsetConverterUseFallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint CharsetConverterUseFallbackPropertyInfo = (~) Bool type AttrBaseTypeConstraint CharsetConverterUseFallbackPropertyInfo = CharsetConverterK type AttrGetType CharsetConverterUseFallbackPropertyInfo = Bool type AttrLabel CharsetConverterUseFallbackPropertyInfo = "CharsetConverter::use-fallback" attrGet _ = getCharsetConverterUseFallback attrSet _ = setCharsetConverterUseFallback attrConstruct _ = constructCharsetConverterUseFallback type instance AttributeList CharsetConverter = '[ '("from-charset", CharsetConverterFromCharsetPropertyInfo), '("to-charset", CharsetConverterToCharsetPropertyInfo), '("use-fallback", CharsetConverterUseFallbackPropertyInfo)] type instance AttributeList Converter = '[ ] -- VVV Prop "converter" -- Type: TInterface "Gio" "Converter" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getConverterInputStreamConverter :: (MonadIO m, ConverterInputStreamK o) => o -> m Converter getConverterInputStreamConverter obj = liftIO $ getObjectPropertyObject obj "converter" Converter constructConverterInputStreamConverter :: (ConverterK a) => a -> IO ([Char], GValue) constructConverterInputStreamConverter val = constructObjectPropertyObject "converter" val data ConverterInputStreamConverterPropertyInfo instance AttrInfo ConverterInputStreamConverterPropertyInfo where type AttrAllowedOps ConverterInputStreamConverterPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ConverterInputStreamConverterPropertyInfo = ConverterK type AttrBaseTypeConstraint ConverterInputStreamConverterPropertyInfo = ConverterInputStreamK type AttrGetType ConverterInputStreamConverterPropertyInfo = Converter type AttrLabel ConverterInputStreamConverterPropertyInfo = "ConverterInputStream::converter" attrGet _ = getConverterInputStreamConverter attrSet _ = undefined attrConstruct _ = constructConverterInputStreamConverter type instance AttributeList ConverterInputStream = '[ '("base-stream", FilterInputStreamBaseStreamPropertyInfo), '("close-base-stream", FilterInputStreamCloseBaseStreamPropertyInfo), '("converter", ConverterInputStreamConverterPropertyInfo)] -- VVV Prop "converter" -- Type: TInterface "Gio" "Converter" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getConverterOutputStreamConverter :: (MonadIO m, ConverterOutputStreamK o) => o -> m Converter getConverterOutputStreamConverter obj = liftIO $ getObjectPropertyObject obj "converter" Converter constructConverterOutputStreamConverter :: (ConverterK a) => a -> IO ([Char], GValue) constructConverterOutputStreamConverter val = constructObjectPropertyObject "converter" val data ConverterOutputStreamConverterPropertyInfo instance AttrInfo ConverterOutputStreamConverterPropertyInfo where type AttrAllowedOps ConverterOutputStreamConverterPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ConverterOutputStreamConverterPropertyInfo = ConverterK type AttrBaseTypeConstraint ConverterOutputStreamConverterPropertyInfo = ConverterOutputStreamK type AttrGetType ConverterOutputStreamConverterPropertyInfo = Converter type AttrLabel ConverterOutputStreamConverterPropertyInfo = "ConverterOutputStream::converter" attrGet _ = getConverterOutputStreamConverter attrSet _ = undefined attrConstruct _ = constructConverterOutputStreamConverter type instance AttributeList ConverterOutputStream = '[ '("base-stream", FilterOutputStreamBaseStreamPropertyInfo), '("close-base-stream", FilterOutputStreamCloseBaseStreamPropertyInfo), '("converter", ConverterOutputStreamConverterPropertyInfo)] type instance AttributeList Credentials = '[ ] type instance AttributeList DBusActionGroup = '[ ] type instance AttributeList DBusAuthObserver = '[ ] -- VVV Prop "address" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable,PropertyConstructOnly] constructDBusConnectionAddress :: T.Text -> IO ([Char], GValue) constructDBusConnectionAddress val = constructObjectPropertyString "address" val data DBusConnectionAddressPropertyInfo instance AttrInfo DBusConnectionAddressPropertyInfo where type AttrAllowedOps DBusConnectionAddressPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint DBusConnectionAddressPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusConnectionAddressPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionAddressPropertyInfo = () type AttrLabel DBusConnectionAddressPropertyInfo = "DBusConnection::address" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructDBusConnectionAddress -- VVV Prop "authentication-observer" -- Type: TInterface "Gio" "DBusAuthObserver" -- Flags: [PropertyWritable,PropertyConstructOnly] constructDBusConnectionAuthenticationObserver :: (DBusAuthObserverK a) => a -> IO ([Char], GValue) constructDBusConnectionAuthenticationObserver val = constructObjectPropertyObject "authentication-observer" val data DBusConnectionAuthenticationObserverPropertyInfo instance AttrInfo DBusConnectionAuthenticationObserverPropertyInfo where type AttrAllowedOps DBusConnectionAuthenticationObserverPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint DBusConnectionAuthenticationObserverPropertyInfo = DBusAuthObserverK type AttrBaseTypeConstraint DBusConnectionAuthenticationObserverPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionAuthenticationObserverPropertyInfo = () type AttrLabel DBusConnectionAuthenticationObserverPropertyInfo = "DBusConnection::authentication-observer" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructDBusConnectionAuthenticationObserver -- VVV Prop "capabilities" -- Type: TInterface "Gio" "DBusCapabilityFlags" -- Flags: [PropertyReadable] getDBusConnectionCapabilities :: (MonadIO m, DBusConnectionK o) => o -> m [DBusCapabilityFlags] getDBusConnectionCapabilities obj = liftIO $ getObjectPropertyFlags obj "capabilities" data DBusConnectionCapabilitiesPropertyInfo instance AttrInfo DBusConnectionCapabilitiesPropertyInfo where type AttrAllowedOps DBusConnectionCapabilitiesPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusConnectionCapabilitiesPropertyInfo = (~) () type AttrBaseTypeConstraint DBusConnectionCapabilitiesPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionCapabilitiesPropertyInfo = [DBusCapabilityFlags] type AttrLabel DBusConnectionCapabilitiesPropertyInfo = "DBusConnection::capabilities" attrGet _ = getDBusConnectionCapabilities attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "closed" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getDBusConnectionClosed :: (MonadIO m, DBusConnectionK o) => o -> m Bool getDBusConnectionClosed obj = liftIO $ getObjectPropertyBool obj "closed" data DBusConnectionClosedPropertyInfo instance AttrInfo DBusConnectionClosedPropertyInfo where type AttrAllowedOps DBusConnectionClosedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusConnectionClosedPropertyInfo = (~) () type AttrBaseTypeConstraint DBusConnectionClosedPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionClosedPropertyInfo = Bool type AttrLabel DBusConnectionClosedPropertyInfo = "DBusConnection::closed" attrGet _ = getDBusConnectionClosed attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "exit-on-close" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getDBusConnectionExitOnClose :: (MonadIO m, DBusConnectionK o) => o -> m Bool getDBusConnectionExitOnClose obj = liftIO $ getObjectPropertyBool obj "exit-on-close" setDBusConnectionExitOnClose :: (MonadIO m, DBusConnectionK o) => o -> Bool -> m () setDBusConnectionExitOnClose obj val = liftIO $ setObjectPropertyBool obj "exit-on-close" val constructDBusConnectionExitOnClose :: Bool -> IO ([Char], GValue) constructDBusConnectionExitOnClose val = constructObjectPropertyBool "exit-on-close" val data DBusConnectionExitOnClosePropertyInfo instance AttrInfo DBusConnectionExitOnClosePropertyInfo where type AttrAllowedOps DBusConnectionExitOnClosePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusConnectionExitOnClosePropertyInfo = (~) Bool type AttrBaseTypeConstraint DBusConnectionExitOnClosePropertyInfo = DBusConnectionK type AttrGetType DBusConnectionExitOnClosePropertyInfo = Bool type AttrLabel DBusConnectionExitOnClosePropertyInfo = "DBusConnection::exit-on-close" attrGet _ = getDBusConnectionExitOnClose attrSet _ = setDBusConnectionExitOnClose attrConstruct _ = constructDBusConnectionExitOnClose -- VVV Prop "flags" -- Type: TInterface "Gio" "DBusConnectionFlags" -- Flags: [PropertyWritable,PropertyConstructOnly] constructDBusConnectionFlags :: [DBusConnectionFlags] -> IO ([Char], GValue) constructDBusConnectionFlags val = constructObjectPropertyFlags "flags" val data DBusConnectionFlagsPropertyInfo instance AttrInfo DBusConnectionFlagsPropertyInfo where type AttrAllowedOps DBusConnectionFlagsPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint DBusConnectionFlagsPropertyInfo = (~) [DBusConnectionFlags] type AttrBaseTypeConstraint DBusConnectionFlagsPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionFlagsPropertyInfo = () type AttrLabel DBusConnectionFlagsPropertyInfo = "DBusConnection::flags" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructDBusConnectionFlags -- VVV Prop "guid" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusConnectionGuid :: (MonadIO m, DBusConnectionK o) => o -> m T.Text getDBusConnectionGuid obj = liftIO $ getObjectPropertyString obj "guid" constructDBusConnectionGuid :: T.Text -> IO ([Char], GValue) constructDBusConnectionGuid val = constructObjectPropertyString "guid" val data DBusConnectionGuidPropertyInfo instance AttrInfo DBusConnectionGuidPropertyInfo where type AttrAllowedOps DBusConnectionGuidPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusConnectionGuidPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusConnectionGuidPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionGuidPropertyInfo = T.Text type AttrLabel DBusConnectionGuidPropertyInfo = "DBusConnection::guid" attrGet _ = getDBusConnectionGuid attrSet _ = undefined attrConstruct _ = constructDBusConnectionGuid -- VVV Prop "stream" -- Type: TInterface "Gio" "IOStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusConnectionStream :: (MonadIO m, DBusConnectionK o) => o -> m IOStream getDBusConnectionStream obj = liftIO $ getObjectPropertyObject obj "stream" IOStream constructDBusConnectionStream :: (IOStreamK a) => a -> IO ([Char], GValue) constructDBusConnectionStream val = constructObjectPropertyObject "stream" val data DBusConnectionStreamPropertyInfo instance AttrInfo DBusConnectionStreamPropertyInfo where type AttrAllowedOps DBusConnectionStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusConnectionStreamPropertyInfo = IOStreamK type AttrBaseTypeConstraint DBusConnectionStreamPropertyInfo = DBusConnectionK type AttrGetType DBusConnectionStreamPropertyInfo = IOStream type AttrLabel DBusConnectionStreamPropertyInfo = "DBusConnection::stream" attrGet _ = getDBusConnectionStream attrSet _ = undefined attrConstruct _ = constructDBusConnectionStream -- VVV Prop "unique-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getDBusConnectionUniqueName :: (MonadIO m, DBusConnectionK o) => o -> m T.Text getDBusConnectionUniqueName obj = liftIO $ getObjectPropertyString obj "unique-name" data DBusConnectionUniqueNamePropertyInfo instance AttrInfo DBusConnectionUniqueNamePropertyInfo where type AttrAllowedOps DBusConnectionUniqueNamePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusConnectionUniqueNamePropertyInfo = (~) () type AttrBaseTypeConstraint DBusConnectionUniqueNamePropertyInfo = DBusConnectionK type AttrGetType DBusConnectionUniqueNamePropertyInfo = T.Text type AttrLabel DBusConnectionUniqueNamePropertyInfo = "DBusConnection::unique-name" attrGet _ = getDBusConnectionUniqueName attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList DBusConnection = '[ '("address", DBusConnectionAddressPropertyInfo), '("authentication-observer", DBusConnectionAuthenticationObserverPropertyInfo), '("capabilities", DBusConnectionCapabilitiesPropertyInfo), '("closed", DBusConnectionClosedPropertyInfo), '("exit-on-close", DBusConnectionExitOnClosePropertyInfo), '("flags", DBusConnectionFlagsPropertyInfo), '("guid", DBusConnectionGuidPropertyInfo), '("stream", DBusConnectionStreamPropertyInfo), '("unique-name", DBusConnectionUniqueNamePropertyInfo)] type instance AttributeList DBusInterface = '[ ] -- VVV Prop "g-flags" -- Type: TInterface "Gio" "DBusInterfaceSkeletonFlags" -- Flags: [PropertyReadable,PropertyWritable] getDBusInterfaceSkeletonGFlags :: (MonadIO m, DBusInterfaceSkeletonK o) => o -> m [DBusInterfaceSkeletonFlags] getDBusInterfaceSkeletonGFlags obj = liftIO $ getObjectPropertyFlags obj "g-flags" setDBusInterfaceSkeletonGFlags :: (MonadIO m, DBusInterfaceSkeletonK o) => o -> [DBusInterfaceSkeletonFlags] -> m () setDBusInterfaceSkeletonGFlags obj val = liftIO $ setObjectPropertyFlags obj "g-flags" val constructDBusInterfaceSkeletonGFlags :: [DBusInterfaceSkeletonFlags] -> IO ([Char], GValue) constructDBusInterfaceSkeletonGFlags val = constructObjectPropertyFlags "g-flags" val data DBusInterfaceSkeletonGFlagsPropertyInfo instance AttrInfo DBusInterfaceSkeletonGFlagsPropertyInfo where type AttrAllowedOps DBusInterfaceSkeletonGFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusInterfaceSkeletonGFlagsPropertyInfo = (~) [DBusInterfaceSkeletonFlags] type AttrBaseTypeConstraint DBusInterfaceSkeletonGFlagsPropertyInfo = DBusInterfaceSkeletonK type AttrGetType DBusInterfaceSkeletonGFlagsPropertyInfo = [DBusInterfaceSkeletonFlags] type AttrLabel DBusInterfaceSkeletonGFlagsPropertyInfo = "DBusInterfaceSkeleton::g-flags" attrGet _ = getDBusInterfaceSkeletonGFlags attrSet _ = setDBusInterfaceSkeletonGFlags attrConstruct _ = constructDBusInterfaceSkeletonGFlags type instance AttributeList DBusInterfaceSkeleton = '[ '("g-flags", DBusInterfaceSkeletonGFlagsPropertyInfo)] type instance AttributeList DBusMenuModel = '[ ] -- VVV Prop "locked" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getDBusMessageLocked :: (MonadIO m, DBusMessageK o) => o -> m Bool getDBusMessageLocked obj = liftIO $ getObjectPropertyBool obj "locked" data DBusMessageLockedPropertyInfo instance AttrInfo DBusMessageLockedPropertyInfo where type AttrAllowedOps DBusMessageLockedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusMessageLockedPropertyInfo = (~) () type AttrBaseTypeConstraint DBusMessageLockedPropertyInfo = DBusMessageK type AttrGetType DBusMessageLockedPropertyInfo = Bool type AttrLabel DBusMessageLockedPropertyInfo = "DBusMessage::locked" attrGet _ = getDBusMessageLocked attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList DBusMessage = '[ '("locked", DBusMessageLockedPropertyInfo)] type instance AttributeList DBusMethodInvocation = '[ ] type instance AttributeList DBusObject = '[ ] type instance AttributeList DBusObjectManager = '[ ] -- VVV Prop "bus-type" -- Type: TInterface "Gio" "BusType" -- Flags: [PropertyWritable,PropertyConstructOnly] constructDBusObjectManagerClientBusType :: BusType -> IO ([Char], GValue) constructDBusObjectManagerClientBusType val = constructObjectPropertyEnum "bus-type" val data DBusObjectManagerClientBusTypePropertyInfo instance AttrInfo DBusObjectManagerClientBusTypePropertyInfo where type AttrAllowedOps DBusObjectManagerClientBusTypePropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = (~) BusType type AttrBaseTypeConstraint DBusObjectManagerClientBusTypePropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientBusTypePropertyInfo = () type AttrLabel DBusObjectManagerClientBusTypePropertyInfo = "DBusObjectManagerClient::bus-type" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientBusType -- VVV Prop "connection" -- Type: TInterface "Gio" "DBusConnection" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientConnection :: (MonadIO m, DBusObjectManagerClientK o) => o -> m DBusConnection getDBusObjectManagerClientConnection obj = liftIO $ getObjectPropertyObject obj "connection" DBusConnection constructDBusObjectManagerClientConnection :: (DBusConnectionK a) => a -> IO ([Char], GValue) constructDBusObjectManagerClientConnection val = constructObjectPropertyObject "connection" val data DBusObjectManagerClientConnectionPropertyInfo instance AttrInfo DBusObjectManagerClientConnectionPropertyInfo where type AttrAllowedOps DBusObjectManagerClientConnectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = DBusConnectionK type AttrBaseTypeConstraint DBusObjectManagerClientConnectionPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientConnectionPropertyInfo = DBusConnection type AttrLabel DBusObjectManagerClientConnectionPropertyInfo = "DBusObjectManagerClient::connection" attrGet _ = getDBusObjectManagerClientConnection attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientConnection -- VVV Prop "flags" -- Type: TInterface "Gio" "DBusObjectManagerClientFlags" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientFlags :: (MonadIO m, DBusObjectManagerClientK o) => o -> m [DBusObjectManagerClientFlags] getDBusObjectManagerClientFlags obj = liftIO $ getObjectPropertyFlags obj "flags" constructDBusObjectManagerClientFlags :: [DBusObjectManagerClientFlags] -> IO ([Char], GValue) constructDBusObjectManagerClientFlags val = constructObjectPropertyFlags "flags" val data DBusObjectManagerClientFlagsPropertyInfo instance AttrInfo DBusObjectManagerClientFlagsPropertyInfo where type AttrAllowedOps DBusObjectManagerClientFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = (~) [DBusObjectManagerClientFlags] type AttrBaseTypeConstraint DBusObjectManagerClientFlagsPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientFlagsPropertyInfo = [DBusObjectManagerClientFlags] type AttrLabel DBusObjectManagerClientFlagsPropertyInfo = "DBusObjectManagerClient::flags" attrGet _ = getDBusObjectManagerClientFlags attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientFlags -- VVV Prop "get-proxy-type-destroy-notify" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientGetProxyTypeDestroyNotify :: (MonadIO m, DBusObjectManagerClientK o) => o -> m (Ptr ()) getDBusObjectManagerClientGetProxyTypeDestroyNotify obj = liftIO $ getObjectPropertyPtr obj "get-proxy-type-destroy-notify" constructDBusObjectManagerClientGetProxyTypeDestroyNotify :: (Ptr ()) -> IO ([Char], GValue) constructDBusObjectManagerClientGetProxyTypeDestroyNotify val = constructObjectPropertyPtr "get-proxy-type-destroy-notify" val data DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo instance AttrInfo DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo where type AttrAllowedOps DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = (Ptr ()) type AttrLabel DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo = "DBusObjectManagerClient::get-proxy-type-destroy-notify" attrGet _ = getDBusObjectManagerClientGetProxyTypeDestroyNotify attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientGetProxyTypeDestroyNotify -- VVV Prop "get-proxy-type-func" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientGetProxyTypeFunc :: (MonadIO m, DBusObjectManagerClientK o) => o -> m (Ptr ()) getDBusObjectManagerClientGetProxyTypeFunc obj = liftIO $ getObjectPropertyPtr obj "get-proxy-type-func" constructDBusObjectManagerClientGetProxyTypeFunc :: (Ptr ()) -> IO ([Char], GValue) constructDBusObjectManagerClientGetProxyTypeFunc val = constructObjectPropertyPtr "get-proxy-type-func" val data DBusObjectManagerClientGetProxyTypeFuncPropertyInfo instance AttrInfo DBusObjectManagerClientGetProxyTypeFuncPropertyInfo where type AttrAllowedOps DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = (Ptr ()) type AttrLabel DBusObjectManagerClientGetProxyTypeFuncPropertyInfo = "DBusObjectManagerClient::get-proxy-type-func" attrGet _ = getDBusObjectManagerClientGetProxyTypeFunc attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientGetProxyTypeFunc -- VVV Prop "get-proxy-type-user-data" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientGetProxyTypeUserData :: (MonadIO m, DBusObjectManagerClientK o) => o -> m (Ptr ()) getDBusObjectManagerClientGetProxyTypeUserData obj = liftIO $ getObjectPropertyPtr obj "get-proxy-type-user-data" constructDBusObjectManagerClientGetProxyTypeUserData :: (Ptr ()) -> IO ([Char], GValue) constructDBusObjectManagerClientGetProxyTypeUserData val = constructObjectPropertyPtr "get-proxy-type-user-data" val data DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo instance AttrInfo DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo where type AttrAllowedOps DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = (Ptr ()) type AttrLabel DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo = "DBusObjectManagerClient::get-proxy-type-user-data" attrGet _ = getDBusObjectManagerClientGetProxyTypeUserData attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientGetProxyTypeUserData -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientName :: (MonadIO m, DBusObjectManagerClientK o) => o -> m T.Text getDBusObjectManagerClientName obj = liftIO $ getObjectPropertyString obj "name" constructDBusObjectManagerClientName :: T.Text -> IO ([Char], GValue) constructDBusObjectManagerClientName val = constructObjectPropertyString "name" val data DBusObjectManagerClientNamePropertyInfo instance AttrInfo DBusObjectManagerClientNamePropertyInfo where type AttrAllowedOps DBusObjectManagerClientNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusObjectManagerClientNamePropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientNamePropertyInfo = T.Text type AttrLabel DBusObjectManagerClientNamePropertyInfo = "DBusObjectManagerClient::name" attrGet _ = getDBusObjectManagerClientName attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientName -- VVV Prop "name-owner" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getDBusObjectManagerClientNameOwner :: (MonadIO m, DBusObjectManagerClientK o) => o -> m T.Text getDBusObjectManagerClientNameOwner obj = liftIO $ getObjectPropertyString obj "name-owner" data DBusObjectManagerClientNameOwnerPropertyInfo instance AttrInfo DBusObjectManagerClientNameOwnerPropertyInfo where type AttrAllowedOps DBusObjectManagerClientNameOwnerPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = (~) () type AttrBaseTypeConstraint DBusObjectManagerClientNameOwnerPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientNameOwnerPropertyInfo = T.Text type AttrLabel DBusObjectManagerClientNameOwnerPropertyInfo = "DBusObjectManagerClient::name-owner" attrGet _ = getDBusObjectManagerClientNameOwner attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "object-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerClientObjectPath :: (MonadIO m, DBusObjectManagerClientK o) => o -> m T.Text getDBusObjectManagerClientObjectPath obj = liftIO $ getObjectPropertyString obj "object-path" constructDBusObjectManagerClientObjectPath :: T.Text -> IO ([Char], GValue) constructDBusObjectManagerClientObjectPath val = constructObjectPropertyString "object-path" val data DBusObjectManagerClientObjectPathPropertyInfo instance AttrInfo DBusObjectManagerClientObjectPathPropertyInfo where type AttrAllowedOps DBusObjectManagerClientObjectPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusObjectManagerClientObjectPathPropertyInfo = DBusObjectManagerClientK type AttrGetType DBusObjectManagerClientObjectPathPropertyInfo = T.Text type AttrLabel DBusObjectManagerClientObjectPathPropertyInfo = "DBusObjectManagerClient::object-path" attrGet _ = getDBusObjectManagerClientObjectPath attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerClientObjectPath type instance AttributeList DBusObjectManagerClient = '[ '("bus-type", DBusObjectManagerClientBusTypePropertyInfo), '("connection", DBusObjectManagerClientConnectionPropertyInfo), '("flags", DBusObjectManagerClientFlagsPropertyInfo), '("get-proxy-type-destroy-notify", DBusObjectManagerClientGetProxyTypeDestroyNotifyPropertyInfo), '("get-proxy-type-func", DBusObjectManagerClientGetProxyTypeFuncPropertyInfo), '("get-proxy-type-user-data", DBusObjectManagerClientGetProxyTypeUserDataPropertyInfo), '("name", DBusObjectManagerClientNamePropertyInfo), '("name-owner", DBusObjectManagerClientNameOwnerPropertyInfo), '("object-path", DBusObjectManagerClientObjectPathPropertyInfo)] -- VVV Prop "connection" -- Type: TInterface "Gio" "DBusConnection" -- Flags: [PropertyReadable,PropertyWritable] getDBusObjectManagerServerConnection :: (MonadIO m, DBusObjectManagerServerK o) => o -> m DBusConnection getDBusObjectManagerServerConnection obj = liftIO $ getObjectPropertyObject obj "connection" DBusConnection setDBusObjectManagerServerConnection :: (MonadIO m, DBusObjectManagerServerK o, DBusConnectionK a) => o -> a -> m () setDBusObjectManagerServerConnection obj val = liftIO $ setObjectPropertyObject obj "connection" val constructDBusObjectManagerServerConnection :: (DBusConnectionK a) => a -> IO ([Char], GValue) constructDBusObjectManagerServerConnection val = constructObjectPropertyObject "connection" val data DBusObjectManagerServerConnectionPropertyInfo instance AttrInfo DBusObjectManagerServerConnectionPropertyInfo where type AttrAllowedOps DBusObjectManagerServerConnectionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerServerConnectionPropertyInfo = DBusConnectionK type AttrBaseTypeConstraint DBusObjectManagerServerConnectionPropertyInfo = DBusObjectManagerServerK type AttrGetType DBusObjectManagerServerConnectionPropertyInfo = DBusConnection type AttrLabel DBusObjectManagerServerConnectionPropertyInfo = "DBusObjectManagerServer::connection" attrGet _ = getDBusObjectManagerServerConnection attrSet _ = setDBusObjectManagerServerConnection attrConstruct _ = constructDBusObjectManagerServerConnection -- VVV Prop "object-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectManagerServerObjectPath :: (MonadIO m, DBusObjectManagerServerK o) => o -> m T.Text getDBusObjectManagerServerObjectPath obj = liftIO $ getObjectPropertyString obj "object-path" constructDBusObjectManagerServerObjectPath :: T.Text -> IO ([Char], GValue) constructDBusObjectManagerServerObjectPath val = constructObjectPropertyString "object-path" val data DBusObjectManagerServerObjectPathPropertyInfo instance AttrInfo DBusObjectManagerServerObjectPathPropertyInfo where type AttrAllowedOps DBusObjectManagerServerObjectPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectManagerServerObjectPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusObjectManagerServerObjectPathPropertyInfo = DBusObjectManagerServerK type AttrGetType DBusObjectManagerServerObjectPathPropertyInfo = T.Text type AttrLabel DBusObjectManagerServerObjectPathPropertyInfo = "DBusObjectManagerServer::object-path" attrGet _ = getDBusObjectManagerServerObjectPath attrSet _ = undefined attrConstruct _ = constructDBusObjectManagerServerObjectPath type instance AttributeList DBusObjectManagerServer = '[ '("connection", DBusObjectManagerServerConnectionPropertyInfo), '("object-path", DBusObjectManagerServerObjectPathPropertyInfo)] -- VVV Prop "g-connection" -- Type: TInterface "Gio" "DBusConnection" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectProxyGConnection :: (MonadIO m, DBusObjectProxyK o) => o -> m DBusConnection getDBusObjectProxyGConnection obj = liftIO $ getObjectPropertyObject obj "g-connection" DBusConnection constructDBusObjectProxyGConnection :: (DBusConnectionK a) => a -> IO ([Char], GValue) constructDBusObjectProxyGConnection val = constructObjectPropertyObject "g-connection" val data DBusObjectProxyGConnectionPropertyInfo instance AttrInfo DBusObjectProxyGConnectionPropertyInfo where type AttrAllowedOps DBusObjectProxyGConnectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectProxyGConnectionPropertyInfo = DBusConnectionK type AttrBaseTypeConstraint DBusObjectProxyGConnectionPropertyInfo = DBusObjectProxyK type AttrGetType DBusObjectProxyGConnectionPropertyInfo = DBusConnection type AttrLabel DBusObjectProxyGConnectionPropertyInfo = "DBusObjectProxy::g-connection" attrGet _ = getDBusObjectProxyGConnection attrSet _ = undefined attrConstruct _ = constructDBusObjectProxyGConnection -- VVV Prop "g-object-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusObjectProxyGObjectPath :: (MonadIO m, DBusObjectProxyK o) => o -> m T.Text getDBusObjectProxyGObjectPath obj = liftIO $ getObjectPropertyString obj "g-object-path" constructDBusObjectProxyGObjectPath :: T.Text -> IO ([Char], GValue) constructDBusObjectProxyGObjectPath val = constructObjectPropertyString "g-object-path" val data DBusObjectProxyGObjectPathPropertyInfo instance AttrInfo DBusObjectProxyGObjectPathPropertyInfo where type AttrAllowedOps DBusObjectProxyGObjectPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectProxyGObjectPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusObjectProxyGObjectPathPropertyInfo = DBusObjectProxyK type AttrGetType DBusObjectProxyGObjectPathPropertyInfo = T.Text type AttrLabel DBusObjectProxyGObjectPathPropertyInfo = "DBusObjectProxy::g-object-path" attrGet _ = getDBusObjectProxyGObjectPath attrSet _ = undefined attrConstruct _ = constructDBusObjectProxyGObjectPath type instance AttributeList DBusObjectProxy = '[ '("g-connection", DBusObjectProxyGConnectionPropertyInfo), '("g-object-path", DBusObjectProxyGObjectPathPropertyInfo)] -- VVV Prop "g-object-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getDBusObjectSkeletonGObjectPath :: (MonadIO m, DBusObjectSkeletonK o) => o -> m T.Text getDBusObjectSkeletonGObjectPath obj = liftIO $ getObjectPropertyString obj "g-object-path" setDBusObjectSkeletonGObjectPath :: (MonadIO m, DBusObjectSkeletonK o) => o -> T.Text -> m () setDBusObjectSkeletonGObjectPath obj val = liftIO $ setObjectPropertyString obj "g-object-path" val constructDBusObjectSkeletonGObjectPath :: T.Text -> IO ([Char], GValue) constructDBusObjectSkeletonGObjectPath val = constructObjectPropertyString "g-object-path" val data DBusObjectSkeletonGObjectPathPropertyInfo instance AttrInfo DBusObjectSkeletonGObjectPathPropertyInfo where type AttrAllowedOps DBusObjectSkeletonGObjectPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusObjectSkeletonGObjectPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusObjectSkeletonGObjectPathPropertyInfo = DBusObjectSkeletonK type AttrGetType DBusObjectSkeletonGObjectPathPropertyInfo = T.Text type AttrLabel DBusObjectSkeletonGObjectPathPropertyInfo = "DBusObjectSkeleton::g-object-path" attrGet _ = getDBusObjectSkeletonGObjectPath attrSet _ = setDBusObjectSkeletonGObjectPath attrConstruct _ = constructDBusObjectSkeletonGObjectPath type instance AttributeList DBusObjectSkeleton = '[ '("g-object-path", DBusObjectSkeletonGObjectPathPropertyInfo)] -- VVV Prop "g-bus-type" -- Type: TInterface "Gio" "BusType" -- Flags: [PropertyWritable,PropertyConstructOnly] constructDBusProxyGBusType :: BusType -> IO ([Char], GValue) constructDBusProxyGBusType val = constructObjectPropertyEnum "g-bus-type" val data DBusProxyGBusTypePropertyInfo instance AttrInfo DBusProxyGBusTypePropertyInfo where type AttrAllowedOps DBusProxyGBusTypePropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint DBusProxyGBusTypePropertyInfo = (~) BusType type AttrBaseTypeConstraint DBusProxyGBusTypePropertyInfo = DBusProxyK type AttrGetType DBusProxyGBusTypePropertyInfo = () type AttrLabel DBusProxyGBusTypePropertyInfo = "DBusProxy::g-bus-type" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructDBusProxyGBusType -- VVV Prop "g-connection" -- Type: TInterface "Gio" "DBusConnection" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusProxyGConnection :: (MonadIO m, DBusProxyK o) => o -> m DBusConnection getDBusProxyGConnection obj = liftIO $ getObjectPropertyObject obj "g-connection" DBusConnection constructDBusProxyGConnection :: (DBusConnectionK a) => a -> IO ([Char], GValue) constructDBusProxyGConnection val = constructObjectPropertyObject "g-connection" val data DBusProxyGConnectionPropertyInfo instance AttrInfo DBusProxyGConnectionPropertyInfo where type AttrAllowedOps DBusProxyGConnectionPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGConnectionPropertyInfo = DBusConnectionK type AttrBaseTypeConstraint DBusProxyGConnectionPropertyInfo = DBusProxyK type AttrGetType DBusProxyGConnectionPropertyInfo = DBusConnection type AttrLabel DBusProxyGConnectionPropertyInfo = "DBusProxy::g-connection" attrGet _ = getDBusProxyGConnection attrSet _ = undefined attrConstruct _ = constructDBusProxyGConnection -- VVV Prop "g-default-timeout" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getDBusProxyGDefaultTimeout :: (MonadIO m, DBusProxyK o) => o -> m Int32 getDBusProxyGDefaultTimeout obj = liftIO $ getObjectPropertyCInt obj "g-default-timeout" setDBusProxyGDefaultTimeout :: (MonadIO m, DBusProxyK o) => o -> Int32 -> m () setDBusProxyGDefaultTimeout obj val = liftIO $ setObjectPropertyCInt obj "g-default-timeout" val constructDBusProxyGDefaultTimeout :: Int32 -> IO ([Char], GValue) constructDBusProxyGDefaultTimeout val = constructObjectPropertyCInt "g-default-timeout" val data DBusProxyGDefaultTimeoutPropertyInfo instance AttrInfo DBusProxyGDefaultTimeoutPropertyInfo where type AttrAllowedOps DBusProxyGDefaultTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGDefaultTimeoutPropertyInfo = (~) Int32 type AttrBaseTypeConstraint DBusProxyGDefaultTimeoutPropertyInfo = DBusProxyK type AttrGetType DBusProxyGDefaultTimeoutPropertyInfo = Int32 type AttrLabel DBusProxyGDefaultTimeoutPropertyInfo = "DBusProxy::g-default-timeout" attrGet _ = getDBusProxyGDefaultTimeout attrSet _ = setDBusProxyGDefaultTimeout attrConstruct _ = constructDBusProxyGDefaultTimeout -- VVV Prop "g-flags" -- Type: TInterface "Gio" "DBusProxyFlags" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusProxyGFlags :: (MonadIO m, DBusProxyK o) => o -> m [DBusProxyFlags] getDBusProxyGFlags obj = liftIO $ getObjectPropertyFlags obj "g-flags" constructDBusProxyGFlags :: [DBusProxyFlags] -> IO ([Char], GValue) constructDBusProxyGFlags val = constructObjectPropertyFlags "g-flags" val data DBusProxyGFlagsPropertyInfo instance AttrInfo DBusProxyGFlagsPropertyInfo where type AttrAllowedOps DBusProxyGFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGFlagsPropertyInfo = (~) [DBusProxyFlags] type AttrBaseTypeConstraint DBusProxyGFlagsPropertyInfo = DBusProxyK type AttrGetType DBusProxyGFlagsPropertyInfo = [DBusProxyFlags] type AttrLabel DBusProxyGFlagsPropertyInfo = "DBusProxy::g-flags" attrGet _ = getDBusProxyGFlags attrSet _ = undefined attrConstruct _ = constructDBusProxyGFlags -- VVV Prop "g-interface-info" -- Type: TInterface "Gio" "DBusInterfaceInfo" -- Flags: [PropertyReadable,PropertyWritable] getDBusProxyGInterfaceInfo :: (MonadIO m, DBusProxyK o) => o -> m DBusInterfaceInfo getDBusProxyGInterfaceInfo obj = liftIO $ getObjectPropertyBoxed obj "g-interface-info" DBusInterfaceInfo setDBusProxyGInterfaceInfo :: (MonadIO m, DBusProxyK o) => o -> DBusInterfaceInfo -> m () setDBusProxyGInterfaceInfo obj val = liftIO $ setObjectPropertyBoxed obj "g-interface-info" val constructDBusProxyGInterfaceInfo :: DBusInterfaceInfo -> IO ([Char], GValue) constructDBusProxyGInterfaceInfo val = constructObjectPropertyBoxed "g-interface-info" val data DBusProxyGInterfaceInfoPropertyInfo instance AttrInfo DBusProxyGInterfaceInfoPropertyInfo where type AttrAllowedOps DBusProxyGInterfaceInfoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGInterfaceInfoPropertyInfo = (~) DBusInterfaceInfo type AttrBaseTypeConstraint DBusProxyGInterfaceInfoPropertyInfo = DBusProxyK type AttrGetType DBusProxyGInterfaceInfoPropertyInfo = DBusInterfaceInfo type AttrLabel DBusProxyGInterfaceInfoPropertyInfo = "DBusProxy::g-interface-info" attrGet _ = getDBusProxyGInterfaceInfo attrSet _ = setDBusProxyGInterfaceInfo attrConstruct _ = constructDBusProxyGInterfaceInfo -- VVV Prop "g-interface-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusProxyGInterfaceName :: (MonadIO m, DBusProxyK o) => o -> m T.Text getDBusProxyGInterfaceName obj = liftIO $ getObjectPropertyString obj "g-interface-name" constructDBusProxyGInterfaceName :: T.Text -> IO ([Char], GValue) constructDBusProxyGInterfaceName val = constructObjectPropertyString "g-interface-name" val data DBusProxyGInterfaceNamePropertyInfo instance AttrInfo DBusProxyGInterfaceNamePropertyInfo where type AttrAllowedOps DBusProxyGInterfaceNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGInterfaceNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusProxyGInterfaceNamePropertyInfo = DBusProxyK type AttrGetType DBusProxyGInterfaceNamePropertyInfo = T.Text type AttrLabel DBusProxyGInterfaceNamePropertyInfo = "DBusProxy::g-interface-name" attrGet _ = getDBusProxyGInterfaceName attrSet _ = undefined attrConstruct _ = constructDBusProxyGInterfaceName -- VVV Prop "g-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusProxyGName :: (MonadIO m, DBusProxyK o) => o -> m T.Text getDBusProxyGName obj = liftIO $ getObjectPropertyString obj "g-name" constructDBusProxyGName :: T.Text -> IO ([Char], GValue) constructDBusProxyGName val = constructObjectPropertyString "g-name" val data DBusProxyGNamePropertyInfo instance AttrInfo DBusProxyGNamePropertyInfo where type AttrAllowedOps DBusProxyGNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusProxyGNamePropertyInfo = DBusProxyK type AttrGetType DBusProxyGNamePropertyInfo = T.Text type AttrLabel DBusProxyGNamePropertyInfo = "DBusProxy::g-name" attrGet _ = getDBusProxyGName attrSet _ = undefined attrConstruct _ = constructDBusProxyGName -- VVV Prop "g-name-owner" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getDBusProxyGNameOwner :: (MonadIO m, DBusProxyK o) => o -> m T.Text getDBusProxyGNameOwner obj = liftIO $ getObjectPropertyString obj "g-name-owner" data DBusProxyGNameOwnerPropertyInfo instance AttrInfo DBusProxyGNameOwnerPropertyInfo where type AttrAllowedOps DBusProxyGNameOwnerPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusProxyGNameOwnerPropertyInfo = (~) () type AttrBaseTypeConstraint DBusProxyGNameOwnerPropertyInfo = DBusProxyK type AttrGetType DBusProxyGNameOwnerPropertyInfo = T.Text type AttrLabel DBusProxyGNameOwnerPropertyInfo = "DBusProxy::g-name-owner" attrGet _ = getDBusProxyGNameOwner attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "g-object-path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusProxyGObjectPath :: (MonadIO m, DBusProxyK o) => o -> m T.Text getDBusProxyGObjectPath obj = liftIO $ getObjectPropertyString obj "g-object-path" constructDBusProxyGObjectPath :: T.Text -> IO ([Char], GValue) constructDBusProxyGObjectPath val = constructObjectPropertyString "g-object-path" val data DBusProxyGObjectPathPropertyInfo instance AttrInfo DBusProxyGObjectPathPropertyInfo where type AttrAllowedOps DBusProxyGObjectPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusProxyGObjectPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusProxyGObjectPathPropertyInfo = DBusProxyK type AttrGetType DBusProxyGObjectPathPropertyInfo = T.Text type AttrLabel DBusProxyGObjectPathPropertyInfo = "DBusProxy::g-object-path" attrGet _ = getDBusProxyGObjectPath attrSet _ = undefined attrConstruct _ = constructDBusProxyGObjectPath type instance AttributeList DBusProxy = '[ '("g-bus-type", DBusProxyGBusTypePropertyInfo), '("g-connection", DBusProxyGConnectionPropertyInfo), '("g-default-timeout", DBusProxyGDefaultTimeoutPropertyInfo), '("g-flags", DBusProxyGFlagsPropertyInfo), '("g-interface-info", DBusProxyGInterfaceInfoPropertyInfo), '("g-interface-name", DBusProxyGInterfaceNamePropertyInfo), '("g-name", DBusProxyGNamePropertyInfo), '("g-name-owner", DBusProxyGNameOwnerPropertyInfo), '("g-object-path", DBusProxyGObjectPathPropertyInfo)] -- VVV Prop "active" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getDBusServerActive :: (MonadIO m, DBusServerK o) => o -> m Bool getDBusServerActive obj = liftIO $ getObjectPropertyBool obj "active" data DBusServerActivePropertyInfo instance AttrInfo DBusServerActivePropertyInfo where type AttrAllowedOps DBusServerActivePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusServerActivePropertyInfo = (~) () type AttrBaseTypeConstraint DBusServerActivePropertyInfo = DBusServerK type AttrGetType DBusServerActivePropertyInfo = Bool type AttrLabel DBusServerActivePropertyInfo = "DBusServer::active" attrGet _ = getDBusServerActive attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "address" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusServerAddress :: (MonadIO m, DBusServerK o) => o -> m T.Text getDBusServerAddress obj = liftIO $ getObjectPropertyString obj "address" constructDBusServerAddress :: T.Text -> IO ([Char], GValue) constructDBusServerAddress val = constructObjectPropertyString "address" val data DBusServerAddressPropertyInfo instance AttrInfo DBusServerAddressPropertyInfo where type AttrAllowedOps DBusServerAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusServerAddressPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusServerAddressPropertyInfo = DBusServerK type AttrGetType DBusServerAddressPropertyInfo = T.Text type AttrLabel DBusServerAddressPropertyInfo = "DBusServer::address" attrGet _ = getDBusServerAddress attrSet _ = undefined attrConstruct _ = constructDBusServerAddress -- VVV Prop "authentication-observer" -- Type: TInterface "Gio" "DBusAuthObserver" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusServerAuthenticationObserver :: (MonadIO m, DBusServerK o) => o -> m DBusAuthObserver getDBusServerAuthenticationObserver obj = liftIO $ getObjectPropertyObject obj "authentication-observer" DBusAuthObserver constructDBusServerAuthenticationObserver :: (DBusAuthObserverK a) => a -> IO ([Char], GValue) constructDBusServerAuthenticationObserver val = constructObjectPropertyObject "authentication-observer" val data DBusServerAuthenticationObserverPropertyInfo instance AttrInfo DBusServerAuthenticationObserverPropertyInfo where type AttrAllowedOps DBusServerAuthenticationObserverPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusServerAuthenticationObserverPropertyInfo = DBusAuthObserverK type AttrBaseTypeConstraint DBusServerAuthenticationObserverPropertyInfo = DBusServerK type AttrGetType DBusServerAuthenticationObserverPropertyInfo = DBusAuthObserver type AttrLabel DBusServerAuthenticationObserverPropertyInfo = "DBusServer::authentication-observer" attrGet _ = getDBusServerAuthenticationObserver attrSet _ = undefined attrConstruct _ = constructDBusServerAuthenticationObserver -- VVV Prop "client-address" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable] getDBusServerClientAddress :: (MonadIO m, DBusServerK o) => o -> m T.Text getDBusServerClientAddress obj = liftIO $ getObjectPropertyString obj "client-address" data DBusServerClientAddressPropertyInfo instance AttrInfo DBusServerClientAddressPropertyInfo where type AttrAllowedOps DBusServerClientAddressPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint DBusServerClientAddressPropertyInfo = (~) () type AttrBaseTypeConstraint DBusServerClientAddressPropertyInfo = DBusServerK type AttrGetType DBusServerClientAddressPropertyInfo = T.Text type AttrLabel DBusServerClientAddressPropertyInfo = "DBusServer::client-address" attrGet _ = getDBusServerClientAddress attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "flags" -- Type: TInterface "Gio" "DBusServerFlags" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusServerFlags :: (MonadIO m, DBusServerK o) => o -> m [DBusServerFlags] getDBusServerFlags obj = liftIO $ getObjectPropertyFlags obj "flags" constructDBusServerFlags :: [DBusServerFlags] -> IO ([Char], GValue) constructDBusServerFlags val = constructObjectPropertyFlags "flags" val data DBusServerFlagsPropertyInfo instance AttrInfo DBusServerFlagsPropertyInfo where type AttrAllowedOps DBusServerFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusServerFlagsPropertyInfo = (~) [DBusServerFlags] type AttrBaseTypeConstraint DBusServerFlagsPropertyInfo = DBusServerK type AttrGetType DBusServerFlagsPropertyInfo = [DBusServerFlags] type AttrLabel DBusServerFlagsPropertyInfo = "DBusServer::flags" attrGet _ = getDBusServerFlags attrSet _ = undefined attrConstruct _ = constructDBusServerFlags -- VVV Prop "guid" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDBusServerGuid :: (MonadIO m, DBusServerK o) => o -> m T.Text getDBusServerGuid obj = liftIO $ getObjectPropertyString obj "guid" constructDBusServerGuid :: T.Text -> IO ([Char], GValue) constructDBusServerGuid val = constructObjectPropertyString "guid" val data DBusServerGuidPropertyInfo instance AttrInfo DBusServerGuidPropertyInfo where type AttrAllowedOps DBusServerGuidPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DBusServerGuidPropertyInfo = (~) T.Text type AttrBaseTypeConstraint DBusServerGuidPropertyInfo = DBusServerK type AttrGetType DBusServerGuidPropertyInfo = T.Text type AttrLabel DBusServerGuidPropertyInfo = "DBusServer::guid" attrGet _ = getDBusServerGuid attrSet _ = undefined attrConstruct _ = constructDBusServerGuid type instance AttributeList DBusServer = '[ '("active", DBusServerActivePropertyInfo), '("address", DBusServerAddressPropertyInfo), '("authentication-observer", DBusServerAuthenticationObserverPropertyInfo), '("client-address", DBusServerClientAddressPropertyInfo), '("flags", DBusServerFlagsPropertyInfo), '("guid", DBusServerGuidPropertyInfo)] -- VVV Prop "byte-order" -- Type: TInterface "Gio" "DataStreamByteOrder" -- Flags: [PropertyReadable,PropertyWritable] getDataInputStreamByteOrder :: (MonadIO m, DataInputStreamK o) => o -> m DataStreamByteOrder getDataInputStreamByteOrder obj = liftIO $ getObjectPropertyEnum obj "byte-order" setDataInputStreamByteOrder :: (MonadIO m, DataInputStreamK o) => o -> DataStreamByteOrder -> m () setDataInputStreamByteOrder obj val = liftIO $ setObjectPropertyEnum obj "byte-order" val constructDataInputStreamByteOrder :: DataStreamByteOrder -> IO ([Char], GValue) constructDataInputStreamByteOrder val = constructObjectPropertyEnum "byte-order" val data DataInputStreamByteOrderPropertyInfo instance AttrInfo DataInputStreamByteOrderPropertyInfo where type AttrAllowedOps DataInputStreamByteOrderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DataInputStreamByteOrderPropertyInfo = (~) DataStreamByteOrder type AttrBaseTypeConstraint DataInputStreamByteOrderPropertyInfo = DataInputStreamK type AttrGetType DataInputStreamByteOrderPropertyInfo = DataStreamByteOrder type AttrLabel DataInputStreamByteOrderPropertyInfo = "DataInputStream::byte-order" attrGet _ = getDataInputStreamByteOrder attrSet _ = setDataInputStreamByteOrder attrConstruct _ = constructDataInputStreamByteOrder -- VVV Prop "newline-type" -- Type: TInterface "Gio" "DataStreamNewlineType" -- Flags: [PropertyReadable,PropertyWritable] getDataInputStreamNewlineType :: (MonadIO m, DataInputStreamK o) => o -> m DataStreamNewlineType getDataInputStreamNewlineType obj = liftIO $ getObjectPropertyEnum obj "newline-type" setDataInputStreamNewlineType :: (MonadIO m, DataInputStreamK o) => o -> DataStreamNewlineType -> m () setDataInputStreamNewlineType obj val = liftIO $ setObjectPropertyEnum obj "newline-type" val constructDataInputStreamNewlineType :: DataStreamNewlineType -> IO ([Char], GValue) constructDataInputStreamNewlineType val = constructObjectPropertyEnum "newline-type" val data DataInputStreamNewlineTypePropertyInfo instance AttrInfo DataInputStreamNewlineTypePropertyInfo where type AttrAllowedOps DataInputStreamNewlineTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DataInputStreamNewlineTypePropertyInfo = (~) DataStreamNewlineType type AttrBaseTypeConstraint DataInputStreamNewlineTypePropertyInfo = DataInputStreamK type AttrGetType DataInputStreamNewlineTypePropertyInfo = DataStreamNewlineType type AttrLabel DataInputStreamNewlineTypePropertyInfo = "DataInputStream::newline-type" attrGet _ = getDataInputStreamNewlineType attrSet _ = setDataInputStreamNewlineType attrConstruct _ = constructDataInputStreamNewlineType type instance AttributeList DataInputStream = '[ '("base-stream", FilterInputStreamBaseStreamPropertyInfo), '("buffer-size", BufferedInputStreamBufferSizePropertyInfo), '("byte-order", DataInputStreamByteOrderPropertyInfo), '("close-base-stream", FilterInputStreamCloseBaseStreamPropertyInfo), '("newline-type", DataInputStreamNewlineTypePropertyInfo)] -- VVV Prop "byte-order" -- Type: TInterface "Gio" "DataStreamByteOrder" -- Flags: [PropertyReadable,PropertyWritable] getDataOutputStreamByteOrder :: (MonadIO m, DataOutputStreamK o) => o -> m DataStreamByteOrder getDataOutputStreamByteOrder obj = liftIO $ getObjectPropertyEnum obj "byte-order" setDataOutputStreamByteOrder :: (MonadIO m, DataOutputStreamK o) => o -> DataStreamByteOrder -> m () setDataOutputStreamByteOrder obj val = liftIO $ setObjectPropertyEnum obj "byte-order" val constructDataOutputStreamByteOrder :: DataStreamByteOrder -> IO ([Char], GValue) constructDataOutputStreamByteOrder val = constructObjectPropertyEnum "byte-order" val data DataOutputStreamByteOrderPropertyInfo instance AttrInfo DataOutputStreamByteOrderPropertyInfo where type AttrAllowedOps DataOutputStreamByteOrderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DataOutputStreamByteOrderPropertyInfo = (~) DataStreamByteOrder type AttrBaseTypeConstraint DataOutputStreamByteOrderPropertyInfo = DataOutputStreamK type AttrGetType DataOutputStreamByteOrderPropertyInfo = DataStreamByteOrder type AttrLabel DataOutputStreamByteOrderPropertyInfo = "DataOutputStream::byte-order" attrGet _ = getDataOutputStreamByteOrder attrSet _ = setDataOutputStreamByteOrder attrConstruct _ = constructDataOutputStreamByteOrder type instance AttributeList DataOutputStream = '[ '("base-stream", FilterOutputStreamBaseStreamPropertyInfo), '("byte-order", DataOutputStreamByteOrderPropertyInfo), '("close-base-stream", FilterOutputStreamCloseBaseStreamPropertyInfo)] -- VVV Prop "filename" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getDesktopAppInfoFilename :: (MonadIO m, DesktopAppInfoK o) => o -> m T.Text getDesktopAppInfoFilename obj = liftIO $ getObjectPropertyString obj "filename" constructDesktopAppInfoFilename :: T.Text -> IO ([Char], GValue) constructDesktopAppInfoFilename val = constructObjectPropertyString "filename" val data DesktopAppInfoFilenamePropertyInfo instance AttrInfo DesktopAppInfoFilenamePropertyInfo where type AttrAllowedOps DesktopAppInfoFilenamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint DesktopAppInfoFilenamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint DesktopAppInfoFilenamePropertyInfo = DesktopAppInfoK type AttrGetType DesktopAppInfoFilenamePropertyInfo = T.Text type AttrLabel DesktopAppInfoFilenamePropertyInfo = "DesktopAppInfo::filename" attrGet _ = getDesktopAppInfoFilename attrSet _ = undefined attrConstruct _ = constructDesktopAppInfoFilename type instance AttributeList DesktopAppInfo = '[ '("filename", DesktopAppInfoFilenamePropertyInfo)] type instance AttributeList DesktopAppInfoLookup = '[ ] type instance AttributeList Drive = '[ ] -- VVV Prop "icon" -- Type: TInterface "GObject" "Object" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getEmblemIcon :: (MonadIO m, EmblemK o) => o -> m GObject.Object getEmblemIcon obj = liftIO $ getObjectPropertyObject obj "icon" GObject.Object constructEmblemIcon :: (GObject.ObjectK a) => a -> IO ([Char], GValue) constructEmblemIcon val = constructObjectPropertyObject "icon" val data EmblemIconPropertyInfo instance AttrInfo EmblemIconPropertyInfo where type AttrAllowedOps EmblemIconPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EmblemIconPropertyInfo = GObject.ObjectK type AttrBaseTypeConstraint EmblemIconPropertyInfo = EmblemK type AttrGetType EmblemIconPropertyInfo = GObject.Object type AttrLabel EmblemIconPropertyInfo = "Emblem::icon" attrGet _ = getEmblemIcon attrSet _ = undefined attrConstruct _ = constructEmblemIcon -- VVV Prop "origin" -- Type: TInterface "Gio" "EmblemOrigin" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getEmblemOrigin :: (MonadIO m, EmblemK o) => o -> m EmblemOrigin getEmblemOrigin obj = liftIO $ getObjectPropertyEnum obj "origin" constructEmblemOrigin :: EmblemOrigin -> IO ([Char], GValue) constructEmblemOrigin val = constructObjectPropertyEnum "origin" val data EmblemOriginPropertyInfo instance AttrInfo EmblemOriginPropertyInfo where type AttrAllowedOps EmblemOriginPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EmblemOriginPropertyInfo = (~) EmblemOrigin type AttrBaseTypeConstraint EmblemOriginPropertyInfo = EmblemK type AttrGetType EmblemOriginPropertyInfo = EmblemOrigin type AttrLabel EmblemOriginPropertyInfo = "Emblem::origin" attrGet _ = getEmblemOrigin attrSet _ = undefined attrConstruct _ = constructEmblemOrigin type instance AttributeList Emblem = '[ '("icon", EmblemIconPropertyInfo), '("origin", EmblemOriginPropertyInfo)] -- VVV Prop "gicon" -- Type: TInterface "Gio" "Icon" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getEmblemedIconGicon :: (MonadIO m, EmblemedIconK o) => o -> m Icon getEmblemedIconGicon obj = liftIO $ getObjectPropertyObject obj "gicon" Icon constructEmblemedIconGicon :: (IconK a) => a -> IO ([Char], GValue) constructEmblemedIconGicon val = constructObjectPropertyObject "gicon" val data EmblemedIconGiconPropertyInfo instance AttrInfo EmblemedIconGiconPropertyInfo where type AttrAllowedOps EmblemedIconGiconPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint EmblemedIconGiconPropertyInfo = IconK type AttrBaseTypeConstraint EmblemedIconGiconPropertyInfo = EmblemedIconK type AttrGetType EmblemedIconGiconPropertyInfo = Icon type AttrLabel EmblemedIconGiconPropertyInfo = "EmblemedIcon::gicon" attrGet _ = getEmblemedIconGicon attrSet _ = undefined attrConstruct _ = constructEmblemedIconGicon type instance AttributeList EmblemedIcon = '[ '("gicon", EmblemedIconGiconPropertyInfo)] type instance AttributeList File = '[ ] type instance AttributeList FileDescriptorBased = '[ ] -- VVV Prop "container" -- Type: TInterface "Gio" "File" -- Flags: [PropertyWritable,PropertyConstructOnly] constructFileEnumeratorContainer :: (FileK a) => a -> IO ([Char], GValue) constructFileEnumeratorContainer val = constructObjectPropertyObject "container" val data FileEnumeratorContainerPropertyInfo instance AttrInfo FileEnumeratorContainerPropertyInfo where type AttrAllowedOps FileEnumeratorContainerPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint FileEnumeratorContainerPropertyInfo = FileK type AttrBaseTypeConstraint FileEnumeratorContainerPropertyInfo = FileEnumeratorK type AttrGetType FileEnumeratorContainerPropertyInfo = () type AttrLabel FileEnumeratorContainerPropertyInfo = "FileEnumerator::container" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructFileEnumeratorContainer type instance AttributeList FileEnumerator = '[ '("container", FileEnumeratorContainerPropertyInfo)] type instance AttributeList FileIOStream = '[ '("closed", IOStreamClosedPropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo)] -- VVV Prop "file" -- Type: TInterface "Gio" "File" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getFileIconFile :: (MonadIO m, FileIconK o) => o -> m File getFileIconFile obj = liftIO $ getObjectPropertyObject obj "file" File constructFileIconFile :: (FileK a) => a -> IO ([Char], GValue) constructFileIconFile val = constructObjectPropertyObject "file" val data FileIconFilePropertyInfo instance AttrInfo FileIconFilePropertyInfo where type AttrAllowedOps FileIconFilePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileIconFilePropertyInfo = FileK type AttrBaseTypeConstraint FileIconFilePropertyInfo = FileIconK type AttrGetType FileIconFilePropertyInfo = File type AttrLabel FileIconFilePropertyInfo = "FileIcon::file" attrGet _ = getFileIconFile attrSet _ = undefined attrConstruct _ = constructFileIconFile type instance AttributeList FileIcon = '[ '("file", FileIconFilePropertyInfo)] type instance AttributeList FileInfo = '[ ] type instance AttributeList FileInputStream = '[ ] -- VVV Prop "cancelled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getFileMonitorCancelled :: (MonadIO m, FileMonitorK o) => o -> m Bool getFileMonitorCancelled obj = liftIO $ getObjectPropertyBool obj "cancelled" data FileMonitorCancelledPropertyInfo instance AttrInfo FileMonitorCancelledPropertyInfo where type AttrAllowedOps FileMonitorCancelledPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint FileMonitorCancelledPropertyInfo = (~) () type AttrBaseTypeConstraint FileMonitorCancelledPropertyInfo = FileMonitorK type AttrGetType FileMonitorCancelledPropertyInfo = Bool type AttrLabel FileMonitorCancelledPropertyInfo = "FileMonitor::cancelled" attrGet _ = getFileMonitorCancelled attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "context" -- Type: TInterface "GLib" "MainContext" -- Flags: [PropertyWritable,PropertyConstructOnly] constructFileMonitorContext :: GLib.MainContext -> IO ([Char], GValue) constructFileMonitorContext val = constructObjectPropertyBoxed "context" val data FileMonitorContextPropertyInfo instance AttrInfo FileMonitorContextPropertyInfo where type AttrAllowedOps FileMonitorContextPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint FileMonitorContextPropertyInfo = (~) GLib.MainContext type AttrBaseTypeConstraint FileMonitorContextPropertyInfo = FileMonitorK type AttrGetType FileMonitorContextPropertyInfo = () type AttrLabel FileMonitorContextPropertyInfo = "FileMonitor::context" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructFileMonitorContext -- VVV Prop "rate-limit" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getFileMonitorRateLimit :: (MonadIO m, FileMonitorK o) => o -> m Int32 getFileMonitorRateLimit obj = liftIO $ getObjectPropertyCInt obj "rate-limit" setFileMonitorRateLimit :: (MonadIO m, FileMonitorK o) => o -> Int32 -> m () setFileMonitorRateLimit obj val = liftIO $ setObjectPropertyCInt obj "rate-limit" val constructFileMonitorRateLimit :: Int32 -> IO ([Char], GValue) constructFileMonitorRateLimit val = constructObjectPropertyCInt "rate-limit" val data FileMonitorRateLimitPropertyInfo instance AttrInfo FileMonitorRateLimitPropertyInfo where type AttrAllowedOps FileMonitorRateLimitPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FileMonitorRateLimitPropertyInfo = (~) Int32 type AttrBaseTypeConstraint FileMonitorRateLimitPropertyInfo = FileMonitorK type AttrGetType FileMonitorRateLimitPropertyInfo = Int32 type AttrLabel FileMonitorRateLimitPropertyInfo = "FileMonitor::rate-limit" attrGet _ = getFileMonitorRateLimit attrSet _ = setFileMonitorRateLimit attrConstruct _ = constructFileMonitorRateLimit type instance AttributeList FileMonitor = '[ '("cancelled", FileMonitorCancelledPropertyInfo), '("context", FileMonitorContextPropertyInfo), '("rate-limit", FileMonitorRateLimitPropertyInfo)] type instance AttributeList FileOutputStream = '[ ] type instance AttributeList FilenameCompleter = '[ ] -- VVV Prop "base-stream" -- Type: TInterface "Gio" "InputStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getFilterInputStreamBaseStream :: (MonadIO m, FilterInputStreamK o) => o -> m InputStream getFilterInputStreamBaseStream obj = liftIO $ getObjectPropertyObject obj "base-stream" InputStream constructFilterInputStreamBaseStream :: (InputStreamK a) => a -> IO ([Char], GValue) constructFilterInputStreamBaseStream val = constructObjectPropertyObject "base-stream" val data FilterInputStreamBaseStreamPropertyInfo instance AttrInfo FilterInputStreamBaseStreamPropertyInfo where type AttrAllowedOps FilterInputStreamBaseStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FilterInputStreamBaseStreamPropertyInfo = InputStreamK type AttrBaseTypeConstraint FilterInputStreamBaseStreamPropertyInfo = FilterInputStreamK type AttrGetType FilterInputStreamBaseStreamPropertyInfo = InputStream type AttrLabel FilterInputStreamBaseStreamPropertyInfo = "FilterInputStream::base-stream" attrGet _ = getFilterInputStreamBaseStream attrSet _ = undefined attrConstruct _ = constructFilterInputStreamBaseStream -- VVV Prop "close-base-stream" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getFilterInputStreamCloseBaseStream :: (MonadIO m, FilterInputStreamK o) => o -> m Bool getFilterInputStreamCloseBaseStream obj = liftIO $ getObjectPropertyBool obj "close-base-stream" setFilterInputStreamCloseBaseStream :: (MonadIO m, FilterInputStreamK o) => o -> Bool -> m () setFilterInputStreamCloseBaseStream obj val = liftIO $ setObjectPropertyBool obj "close-base-stream" val constructFilterInputStreamCloseBaseStream :: Bool -> IO ([Char], GValue) constructFilterInputStreamCloseBaseStream val = constructObjectPropertyBool "close-base-stream" val data FilterInputStreamCloseBaseStreamPropertyInfo instance AttrInfo FilterInputStreamCloseBaseStreamPropertyInfo where type AttrAllowedOps FilterInputStreamCloseBaseStreamPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FilterInputStreamCloseBaseStreamPropertyInfo = (~) Bool type AttrBaseTypeConstraint FilterInputStreamCloseBaseStreamPropertyInfo = FilterInputStreamK type AttrGetType FilterInputStreamCloseBaseStreamPropertyInfo = Bool type AttrLabel FilterInputStreamCloseBaseStreamPropertyInfo = "FilterInputStream::close-base-stream" attrGet _ = getFilterInputStreamCloseBaseStream attrSet _ = setFilterInputStreamCloseBaseStream attrConstruct _ = constructFilterInputStreamCloseBaseStream type instance AttributeList FilterInputStream = '[ '("base-stream", FilterInputStreamBaseStreamPropertyInfo), '("close-base-stream", FilterInputStreamCloseBaseStreamPropertyInfo)] -- VVV Prop "base-stream" -- Type: TInterface "Gio" "OutputStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getFilterOutputStreamBaseStream :: (MonadIO m, FilterOutputStreamK o) => o -> m OutputStream getFilterOutputStreamBaseStream obj = liftIO $ getObjectPropertyObject obj "base-stream" OutputStream constructFilterOutputStreamBaseStream :: (OutputStreamK a) => a -> IO ([Char], GValue) constructFilterOutputStreamBaseStream val = constructObjectPropertyObject "base-stream" val data FilterOutputStreamBaseStreamPropertyInfo instance AttrInfo FilterOutputStreamBaseStreamPropertyInfo where type AttrAllowedOps FilterOutputStreamBaseStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FilterOutputStreamBaseStreamPropertyInfo = OutputStreamK type AttrBaseTypeConstraint FilterOutputStreamBaseStreamPropertyInfo = FilterOutputStreamK type AttrGetType FilterOutputStreamBaseStreamPropertyInfo = OutputStream type AttrLabel FilterOutputStreamBaseStreamPropertyInfo = "FilterOutputStream::base-stream" attrGet _ = getFilterOutputStreamBaseStream attrSet _ = undefined attrConstruct _ = constructFilterOutputStreamBaseStream -- VVV Prop "close-base-stream" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getFilterOutputStreamCloseBaseStream :: (MonadIO m, FilterOutputStreamK o) => o -> m Bool getFilterOutputStreamCloseBaseStream obj = liftIO $ getObjectPropertyBool obj "close-base-stream" constructFilterOutputStreamCloseBaseStream :: Bool -> IO ([Char], GValue) constructFilterOutputStreamCloseBaseStream val = constructObjectPropertyBool "close-base-stream" val data FilterOutputStreamCloseBaseStreamPropertyInfo instance AttrInfo FilterOutputStreamCloseBaseStreamPropertyInfo where type AttrAllowedOps FilterOutputStreamCloseBaseStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint FilterOutputStreamCloseBaseStreamPropertyInfo = (~) Bool type AttrBaseTypeConstraint FilterOutputStreamCloseBaseStreamPropertyInfo = FilterOutputStreamK type AttrGetType FilterOutputStreamCloseBaseStreamPropertyInfo = Bool type AttrLabel FilterOutputStreamCloseBaseStreamPropertyInfo = "FilterOutputStream::close-base-stream" attrGet _ = getFilterOutputStreamCloseBaseStream attrSet _ = undefined attrConstruct _ = constructFilterOutputStreamCloseBaseStream type instance AttributeList FilterOutputStream = '[ '("base-stream", FilterOutputStreamBaseStreamPropertyInfo), '("close-base-stream", FilterOutputStreamCloseBaseStreamPropertyInfo)] -- VVV Prop "closed" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getIOStreamClosed :: (MonadIO m, IOStreamK o) => o -> m Bool getIOStreamClosed obj = liftIO $ getObjectPropertyBool obj "closed" data IOStreamClosedPropertyInfo instance AttrInfo IOStreamClosedPropertyInfo where type AttrAllowedOps IOStreamClosedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint IOStreamClosedPropertyInfo = (~) () type AttrBaseTypeConstraint IOStreamClosedPropertyInfo = IOStreamK type AttrGetType IOStreamClosedPropertyInfo = Bool type AttrLabel IOStreamClosedPropertyInfo = "IOStream::closed" attrGet _ = getIOStreamClosed attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "input-stream" -- Type: TInterface "Gio" "InputStream" -- Flags: [PropertyReadable] getIOStreamInputStream :: (MonadIO m, IOStreamK o) => o -> m InputStream getIOStreamInputStream obj = liftIO $ getObjectPropertyObject obj "input-stream" InputStream data IOStreamInputStreamPropertyInfo instance AttrInfo IOStreamInputStreamPropertyInfo where type AttrAllowedOps IOStreamInputStreamPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint IOStreamInputStreamPropertyInfo = (~) () type AttrBaseTypeConstraint IOStreamInputStreamPropertyInfo = IOStreamK type AttrGetType IOStreamInputStreamPropertyInfo = InputStream type AttrLabel IOStreamInputStreamPropertyInfo = "IOStream::input-stream" attrGet _ = getIOStreamInputStream attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "output-stream" -- Type: TInterface "Gio" "OutputStream" -- Flags: [PropertyReadable] getIOStreamOutputStream :: (MonadIO m, IOStreamK o) => o -> m OutputStream getIOStreamOutputStream obj = liftIO $ getObjectPropertyObject obj "output-stream" OutputStream data IOStreamOutputStreamPropertyInfo instance AttrInfo IOStreamOutputStreamPropertyInfo where type AttrAllowedOps IOStreamOutputStreamPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint IOStreamOutputStreamPropertyInfo = (~) () type AttrBaseTypeConstraint IOStreamOutputStreamPropertyInfo = IOStreamK type AttrGetType IOStreamOutputStreamPropertyInfo = OutputStream type AttrLabel IOStreamOutputStreamPropertyInfo = "IOStream::output-stream" attrGet _ = getIOStreamOutputStream attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList IOStream = '[ '("closed", IOStreamClosedPropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo)] type instance AttributeList Icon = '[ ] -- VVV Prop "bytes" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getInetAddressBytes :: (MonadIO m, InetAddressK o) => o -> m (Ptr ()) getInetAddressBytes obj = liftIO $ getObjectPropertyPtr obj "bytes" constructInetAddressBytes :: (Ptr ()) -> IO ([Char], GValue) constructInetAddressBytes val = constructObjectPropertyPtr "bytes" val data InetAddressBytesPropertyInfo instance AttrInfo InetAddressBytesPropertyInfo where type AttrAllowedOps InetAddressBytesPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetAddressBytesPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint InetAddressBytesPropertyInfo = InetAddressK type AttrGetType InetAddressBytesPropertyInfo = (Ptr ()) type AttrLabel InetAddressBytesPropertyInfo = "InetAddress::bytes" attrGet _ = getInetAddressBytes attrSet _ = undefined attrConstruct _ = constructInetAddressBytes -- VVV Prop "family" -- Type: TInterface "Gio" "SocketFamily" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getInetAddressFamily :: (MonadIO m, InetAddressK o) => o -> m SocketFamily getInetAddressFamily obj = liftIO $ getObjectPropertyEnum obj "family" constructInetAddressFamily :: SocketFamily -> IO ([Char], GValue) constructInetAddressFamily val = constructObjectPropertyEnum "family" val data InetAddressFamilyPropertyInfo instance AttrInfo InetAddressFamilyPropertyInfo where type AttrAllowedOps InetAddressFamilyPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetAddressFamilyPropertyInfo = (~) SocketFamily type AttrBaseTypeConstraint InetAddressFamilyPropertyInfo = InetAddressK type AttrGetType InetAddressFamilyPropertyInfo = SocketFamily type AttrLabel InetAddressFamilyPropertyInfo = "InetAddress::family" attrGet _ = getInetAddressFamily attrSet _ = undefined attrConstruct _ = constructInetAddressFamily -- VVV Prop "is-any" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsAny :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsAny obj = liftIO $ getObjectPropertyBool obj "is-any" data InetAddressIsAnyPropertyInfo instance AttrInfo InetAddressIsAnyPropertyInfo where type AttrAllowedOps InetAddressIsAnyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsAnyPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsAnyPropertyInfo = InetAddressK type AttrGetType InetAddressIsAnyPropertyInfo = Bool type AttrLabel InetAddressIsAnyPropertyInfo = "InetAddress::is-any" attrGet _ = getInetAddressIsAny attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-link-local" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsLinkLocal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsLinkLocal obj = liftIO $ getObjectPropertyBool obj "is-link-local" data InetAddressIsLinkLocalPropertyInfo instance AttrInfo InetAddressIsLinkLocalPropertyInfo where type AttrAllowedOps InetAddressIsLinkLocalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsLinkLocalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsLinkLocalPropertyInfo = InetAddressK type AttrGetType InetAddressIsLinkLocalPropertyInfo = Bool type AttrLabel InetAddressIsLinkLocalPropertyInfo = "InetAddress::is-link-local" attrGet _ = getInetAddressIsLinkLocal attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-loopback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsLoopback :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsLoopback obj = liftIO $ getObjectPropertyBool obj "is-loopback" data InetAddressIsLoopbackPropertyInfo instance AttrInfo InetAddressIsLoopbackPropertyInfo where type AttrAllowedOps InetAddressIsLoopbackPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsLoopbackPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsLoopbackPropertyInfo = InetAddressK type AttrGetType InetAddressIsLoopbackPropertyInfo = Bool type AttrLabel InetAddressIsLoopbackPropertyInfo = "InetAddress::is-loopback" attrGet _ = getInetAddressIsLoopback attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-mc-global" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsMcGlobal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsMcGlobal obj = liftIO $ getObjectPropertyBool obj "is-mc-global" data InetAddressIsMcGlobalPropertyInfo instance AttrInfo InetAddressIsMcGlobalPropertyInfo where type AttrAllowedOps InetAddressIsMcGlobalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsMcGlobalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsMcGlobalPropertyInfo = InetAddressK type AttrGetType InetAddressIsMcGlobalPropertyInfo = Bool type AttrLabel InetAddressIsMcGlobalPropertyInfo = "InetAddress::is-mc-global" attrGet _ = getInetAddressIsMcGlobal attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-mc-link-local" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsMcLinkLocal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsMcLinkLocal obj = liftIO $ getObjectPropertyBool obj "is-mc-link-local" data InetAddressIsMcLinkLocalPropertyInfo instance AttrInfo InetAddressIsMcLinkLocalPropertyInfo where type AttrAllowedOps InetAddressIsMcLinkLocalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsMcLinkLocalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsMcLinkLocalPropertyInfo = InetAddressK type AttrGetType InetAddressIsMcLinkLocalPropertyInfo = Bool type AttrLabel InetAddressIsMcLinkLocalPropertyInfo = "InetAddress::is-mc-link-local" attrGet _ = getInetAddressIsMcLinkLocal attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-mc-node-local" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsMcNodeLocal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsMcNodeLocal obj = liftIO $ getObjectPropertyBool obj "is-mc-node-local" data InetAddressIsMcNodeLocalPropertyInfo instance AttrInfo InetAddressIsMcNodeLocalPropertyInfo where type AttrAllowedOps InetAddressIsMcNodeLocalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsMcNodeLocalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsMcNodeLocalPropertyInfo = InetAddressK type AttrGetType InetAddressIsMcNodeLocalPropertyInfo = Bool type AttrLabel InetAddressIsMcNodeLocalPropertyInfo = "InetAddress::is-mc-node-local" attrGet _ = getInetAddressIsMcNodeLocal attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-mc-org-local" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsMcOrgLocal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsMcOrgLocal obj = liftIO $ getObjectPropertyBool obj "is-mc-org-local" data InetAddressIsMcOrgLocalPropertyInfo instance AttrInfo InetAddressIsMcOrgLocalPropertyInfo where type AttrAllowedOps InetAddressIsMcOrgLocalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsMcOrgLocalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsMcOrgLocalPropertyInfo = InetAddressK type AttrGetType InetAddressIsMcOrgLocalPropertyInfo = Bool type AttrLabel InetAddressIsMcOrgLocalPropertyInfo = "InetAddress::is-mc-org-local" attrGet _ = getInetAddressIsMcOrgLocal attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-mc-site-local" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsMcSiteLocal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsMcSiteLocal obj = liftIO $ getObjectPropertyBool obj "is-mc-site-local" data InetAddressIsMcSiteLocalPropertyInfo instance AttrInfo InetAddressIsMcSiteLocalPropertyInfo where type AttrAllowedOps InetAddressIsMcSiteLocalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsMcSiteLocalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsMcSiteLocalPropertyInfo = InetAddressK type AttrGetType InetAddressIsMcSiteLocalPropertyInfo = Bool type AttrLabel InetAddressIsMcSiteLocalPropertyInfo = "InetAddress::is-mc-site-local" attrGet _ = getInetAddressIsMcSiteLocal attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-multicast" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsMulticast :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsMulticast obj = liftIO $ getObjectPropertyBool obj "is-multicast" data InetAddressIsMulticastPropertyInfo instance AttrInfo InetAddressIsMulticastPropertyInfo where type AttrAllowedOps InetAddressIsMulticastPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsMulticastPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsMulticastPropertyInfo = InetAddressK type AttrGetType InetAddressIsMulticastPropertyInfo = Bool type AttrLabel InetAddressIsMulticastPropertyInfo = "InetAddress::is-multicast" attrGet _ = getInetAddressIsMulticast attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "is-site-local" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getInetAddressIsSiteLocal :: (MonadIO m, InetAddressK o) => o -> m Bool getInetAddressIsSiteLocal obj = liftIO $ getObjectPropertyBool obj "is-site-local" data InetAddressIsSiteLocalPropertyInfo instance AttrInfo InetAddressIsSiteLocalPropertyInfo where type AttrAllowedOps InetAddressIsSiteLocalPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressIsSiteLocalPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressIsSiteLocalPropertyInfo = InetAddressK type AttrGetType InetAddressIsSiteLocalPropertyInfo = Bool type AttrLabel InetAddressIsSiteLocalPropertyInfo = "InetAddress::is-site-local" attrGet _ = getInetAddressIsSiteLocal attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList InetAddress = '[ '("bytes", InetAddressBytesPropertyInfo), '("family", InetAddressFamilyPropertyInfo), '("is-any", InetAddressIsAnyPropertyInfo), '("is-link-local", InetAddressIsLinkLocalPropertyInfo), '("is-loopback", InetAddressIsLoopbackPropertyInfo), '("is-mc-global", InetAddressIsMcGlobalPropertyInfo), '("is-mc-link-local", InetAddressIsMcLinkLocalPropertyInfo), '("is-mc-node-local", InetAddressIsMcNodeLocalPropertyInfo), '("is-mc-org-local", InetAddressIsMcOrgLocalPropertyInfo), '("is-mc-site-local", InetAddressIsMcSiteLocalPropertyInfo), '("is-multicast", InetAddressIsMulticastPropertyInfo), '("is-site-local", InetAddressIsSiteLocalPropertyInfo)] -- VVV Prop "address" -- Type: TInterface "Gio" "InetAddress" -- Flags: [PropertyReadable,PropertyWritable] getInetAddressMaskAddress :: (MonadIO m, InetAddressMaskK o) => o -> m InetAddress getInetAddressMaskAddress obj = liftIO $ getObjectPropertyObject obj "address" InetAddress setInetAddressMaskAddress :: (MonadIO m, InetAddressMaskK o, InetAddressK a) => o -> a -> m () setInetAddressMaskAddress obj val = liftIO $ setObjectPropertyObject obj "address" val constructInetAddressMaskAddress :: (InetAddressK a) => a -> IO ([Char], GValue) constructInetAddressMaskAddress val = constructObjectPropertyObject "address" val data InetAddressMaskAddressPropertyInfo instance AttrInfo InetAddressMaskAddressPropertyInfo where type AttrAllowedOps InetAddressMaskAddressPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetAddressMaskAddressPropertyInfo = InetAddressK type AttrBaseTypeConstraint InetAddressMaskAddressPropertyInfo = InetAddressMaskK type AttrGetType InetAddressMaskAddressPropertyInfo = InetAddress type AttrLabel InetAddressMaskAddressPropertyInfo = "InetAddressMask::address" attrGet _ = getInetAddressMaskAddress attrSet _ = setInetAddressMaskAddress attrConstruct _ = constructInetAddressMaskAddress -- VVV Prop "family" -- Type: TInterface "Gio" "SocketFamily" -- Flags: [PropertyReadable] getInetAddressMaskFamily :: (MonadIO m, InetAddressMaskK o) => o -> m SocketFamily getInetAddressMaskFamily obj = liftIO $ getObjectPropertyEnum obj "family" data InetAddressMaskFamilyPropertyInfo instance AttrInfo InetAddressMaskFamilyPropertyInfo where type AttrAllowedOps InetAddressMaskFamilyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint InetAddressMaskFamilyPropertyInfo = (~) () type AttrBaseTypeConstraint InetAddressMaskFamilyPropertyInfo = InetAddressMaskK type AttrGetType InetAddressMaskFamilyPropertyInfo = SocketFamily type AttrLabel InetAddressMaskFamilyPropertyInfo = "InetAddressMask::family" attrGet _ = getInetAddressMaskFamily attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "length" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getInetAddressMaskLength :: (MonadIO m, InetAddressMaskK o) => o -> m Word32 getInetAddressMaskLength obj = liftIO $ getObjectPropertyCUInt obj "length" setInetAddressMaskLength :: (MonadIO m, InetAddressMaskK o) => o -> Word32 -> m () setInetAddressMaskLength obj val = liftIO $ setObjectPropertyCUInt obj "length" val constructInetAddressMaskLength :: Word32 -> IO ([Char], GValue) constructInetAddressMaskLength val = constructObjectPropertyCUInt "length" val data InetAddressMaskLengthPropertyInfo instance AttrInfo InetAddressMaskLengthPropertyInfo where type AttrAllowedOps InetAddressMaskLengthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetAddressMaskLengthPropertyInfo = (~) Word32 type AttrBaseTypeConstraint InetAddressMaskLengthPropertyInfo = InetAddressMaskK type AttrGetType InetAddressMaskLengthPropertyInfo = Word32 type AttrLabel InetAddressMaskLengthPropertyInfo = "InetAddressMask::length" attrGet _ = getInetAddressMaskLength attrSet _ = setInetAddressMaskLength attrConstruct _ = constructInetAddressMaskLength type instance AttributeList InetAddressMask = '[ '("address", InetAddressMaskAddressPropertyInfo), '("family", InetAddressMaskFamilyPropertyInfo), '("length", InetAddressMaskLengthPropertyInfo)] -- VVV Prop "address" -- Type: TInterface "Gio" "InetAddress" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getInetSocketAddressAddress :: (MonadIO m, InetSocketAddressK o) => o -> m InetAddress getInetSocketAddressAddress obj = liftIO $ getObjectPropertyObject obj "address" InetAddress constructInetSocketAddressAddress :: (InetAddressK a) => a -> IO ([Char], GValue) constructInetSocketAddressAddress val = constructObjectPropertyObject "address" val data InetSocketAddressAddressPropertyInfo instance AttrInfo InetSocketAddressAddressPropertyInfo where type AttrAllowedOps InetSocketAddressAddressPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetSocketAddressAddressPropertyInfo = InetAddressK type AttrBaseTypeConstraint InetSocketAddressAddressPropertyInfo = InetSocketAddressK type AttrGetType InetSocketAddressAddressPropertyInfo = InetAddress type AttrLabel InetSocketAddressAddressPropertyInfo = "InetSocketAddress::address" attrGet _ = getInetSocketAddressAddress attrSet _ = undefined attrConstruct _ = constructInetSocketAddressAddress -- VVV Prop "flowinfo" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getInetSocketAddressFlowinfo :: (MonadIO m, InetSocketAddressK o) => o -> m Word32 getInetSocketAddressFlowinfo obj = liftIO $ getObjectPropertyCUInt obj "flowinfo" constructInetSocketAddressFlowinfo :: Word32 -> IO ([Char], GValue) constructInetSocketAddressFlowinfo val = constructObjectPropertyCUInt "flowinfo" val data InetSocketAddressFlowinfoPropertyInfo instance AttrInfo InetSocketAddressFlowinfoPropertyInfo where type AttrAllowedOps InetSocketAddressFlowinfoPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetSocketAddressFlowinfoPropertyInfo = (~) Word32 type AttrBaseTypeConstraint InetSocketAddressFlowinfoPropertyInfo = InetSocketAddressK type AttrGetType InetSocketAddressFlowinfoPropertyInfo = Word32 type AttrLabel InetSocketAddressFlowinfoPropertyInfo = "InetSocketAddress::flowinfo" attrGet _ = getInetSocketAddressFlowinfo attrSet _ = undefined attrConstruct _ = constructInetSocketAddressFlowinfo -- VVV Prop "port" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getInetSocketAddressPort :: (MonadIO m, InetSocketAddressK o) => o -> m Word32 getInetSocketAddressPort obj = liftIO $ getObjectPropertyCUInt obj "port" constructInetSocketAddressPort :: Word32 -> IO ([Char], GValue) constructInetSocketAddressPort val = constructObjectPropertyCUInt "port" val data InetSocketAddressPortPropertyInfo instance AttrInfo InetSocketAddressPortPropertyInfo where type AttrAllowedOps InetSocketAddressPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetSocketAddressPortPropertyInfo = (~) Word32 type AttrBaseTypeConstraint InetSocketAddressPortPropertyInfo = InetSocketAddressK type AttrGetType InetSocketAddressPortPropertyInfo = Word32 type AttrLabel InetSocketAddressPortPropertyInfo = "InetSocketAddress::port" attrGet _ = getInetSocketAddressPort attrSet _ = undefined attrConstruct _ = constructInetSocketAddressPort -- VVV Prop "scope-id" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getInetSocketAddressScopeId :: (MonadIO m, InetSocketAddressK o) => o -> m Word32 getInetSocketAddressScopeId obj = liftIO $ getObjectPropertyCUInt obj "scope-id" constructInetSocketAddressScopeId :: Word32 -> IO ([Char], GValue) constructInetSocketAddressScopeId val = constructObjectPropertyCUInt "scope-id" val data InetSocketAddressScopeIdPropertyInfo instance AttrInfo InetSocketAddressScopeIdPropertyInfo where type AttrAllowedOps InetSocketAddressScopeIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint InetSocketAddressScopeIdPropertyInfo = (~) Word32 type AttrBaseTypeConstraint InetSocketAddressScopeIdPropertyInfo = InetSocketAddressK type AttrGetType InetSocketAddressScopeIdPropertyInfo = Word32 type AttrLabel InetSocketAddressScopeIdPropertyInfo = "InetSocketAddress::scope-id" attrGet _ = getInetSocketAddressScopeId attrSet _ = undefined attrConstruct _ = constructInetSocketAddressScopeId type instance AttributeList InetSocketAddress = '[ '("address", InetSocketAddressAddressPropertyInfo), '("family", SocketAddressFamilyPropertyInfo), '("flowinfo", InetSocketAddressFlowinfoPropertyInfo), '("port", InetSocketAddressPortPropertyInfo), '("scope-id", InetSocketAddressScopeIdPropertyInfo)] type instance AttributeList Initable = '[ ] type instance AttributeList InputStream = '[ ] type instance AttributeList ListModel = '[ ] -- VVV Prop "item-type" -- Type: TBasicType TGType -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getListStoreItemType :: (MonadIO m, ListStoreK o) => o -> m GType getListStoreItemType obj = liftIO $ getObjectPropertyGType obj "item-type" constructListStoreItemType :: GType -> IO ([Char], GValue) constructListStoreItemType val = constructObjectPropertyGType "item-type" val data ListStoreItemTypePropertyInfo instance AttrInfo ListStoreItemTypePropertyInfo where type AttrAllowedOps ListStoreItemTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ListStoreItemTypePropertyInfo = (~) GType type AttrBaseTypeConstraint ListStoreItemTypePropertyInfo = ListStoreK type AttrGetType ListStoreItemTypePropertyInfo = GType type AttrLabel ListStoreItemTypePropertyInfo = "ListStore::item-type" attrGet _ = getListStoreItemType attrSet _ = undefined attrConstruct _ = constructListStoreItemType type instance AttributeList ListStore = '[ '("item-type", ListStoreItemTypePropertyInfo)] type instance AttributeList LoadableIcon = '[ ] type instance AttributeList MemoryInputStream = '[ ] -- VVV Prop "data" -- Type: TBasicType TVoid -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getMemoryOutputStreamData :: (MonadIO m, MemoryOutputStreamK o) => o -> m (Ptr ()) getMemoryOutputStreamData obj = liftIO $ getObjectPropertyPtr obj "data" constructMemoryOutputStreamData :: (Ptr ()) -> IO ([Char], GValue) constructMemoryOutputStreamData val = constructObjectPropertyPtr "data" val data MemoryOutputStreamDataPropertyInfo instance AttrInfo MemoryOutputStreamDataPropertyInfo where type AttrAllowedOps MemoryOutputStreamDataPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MemoryOutputStreamDataPropertyInfo = (~) (Ptr ()) type AttrBaseTypeConstraint MemoryOutputStreamDataPropertyInfo = MemoryOutputStreamK type AttrGetType MemoryOutputStreamDataPropertyInfo = (Ptr ()) type AttrLabel MemoryOutputStreamDataPropertyInfo = "MemoryOutputStream::data" attrGet _ = getMemoryOutputStreamData attrSet _ = undefined attrConstruct _ = constructMemoryOutputStreamData -- VVV Prop "data-size" -- Type: TBasicType TUInt64 -- Flags: [PropertyReadable] getMemoryOutputStreamDataSize :: (MonadIO m, MemoryOutputStreamK o) => o -> m Word64 getMemoryOutputStreamDataSize obj = liftIO $ getObjectPropertyUInt64 obj "data-size" data MemoryOutputStreamDataSizePropertyInfo instance AttrInfo MemoryOutputStreamDataSizePropertyInfo where type AttrAllowedOps MemoryOutputStreamDataSizePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint MemoryOutputStreamDataSizePropertyInfo = (~) () type AttrBaseTypeConstraint MemoryOutputStreamDataSizePropertyInfo = MemoryOutputStreamK type AttrGetType MemoryOutputStreamDataSizePropertyInfo = Word64 type AttrLabel MemoryOutputStreamDataSizePropertyInfo = "MemoryOutputStream::data-size" attrGet _ = getMemoryOutputStreamDataSize attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "size" -- Type: TBasicType TUInt64 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getMemoryOutputStreamSize :: (MonadIO m, MemoryOutputStreamK o) => o -> m Word64 getMemoryOutputStreamSize obj = liftIO $ getObjectPropertyUInt64 obj "size" constructMemoryOutputStreamSize :: Word64 -> IO ([Char], GValue) constructMemoryOutputStreamSize val = constructObjectPropertyUInt64 "size" val data MemoryOutputStreamSizePropertyInfo instance AttrInfo MemoryOutputStreamSizePropertyInfo where type AttrAllowedOps MemoryOutputStreamSizePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MemoryOutputStreamSizePropertyInfo = (~) Word64 type AttrBaseTypeConstraint MemoryOutputStreamSizePropertyInfo = MemoryOutputStreamK type AttrGetType MemoryOutputStreamSizePropertyInfo = Word64 type AttrLabel MemoryOutputStreamSizePropertyInfo = "MemoryOutputStream::size" attrGet _ = getMemoryOutputStreamSize attrSet _ = undefined attrConstruct _ = constructMemoryOutputStreamSize type instance AttributeList MemoryOutputStream = '[ '("data", MemoryOutputStreamDataPropertyInfo), '("data-size", MemoryOutputStreamDataSizePropertyInfo), '("size", MemoryOutputStreamSizePropertyInfo)] type instance AttributeList Menu = '[ ] type instance AttributeList MenuAttributeIter = '[ ] type instance AttributeList MenuItem = '[ ] type instance AttributeList MenuLinkIter = '[ ] type instance AttributeList MenuModel = '[ ] type instance AttributeList Mount = '[ ] -- VVV Prop "anonymous" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getMountOperationAnonymous :: (MonadIO m, MountOperationK o) => o -> m Bool getMountOperationAnonymous obj = liftIO $ getObjectPropertyBool obj "anonymous" setMountOperationAnonymous :: (MonadIO m, MountOperationK o) => o -> Bool -> m () setMountOperationAnonymous obj val = liftIO $ setObjectPropertyBool obj "anonymous" val constructMountOperationAnonymous :: Bool -> IO ([Char], GValue) constructMountOperationAnonymous val = constructObjectPropertyBool "anonymous" val data MountOperationAnonymousPropertyInfo instance AttrInfo MountOperationAnonymousPropertyInfo where type AttrAllowedOps MountOperationAnonymousPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationAnonymousPropertyInfo = (~) Bool type AttrBaseTypeConstraint MountOperationAnonymousPropertyInfo = MountOperationK type AttrGetType MountOperationAnonymousPropertyInfo = Bool type AttrLabel MountOperationAnonymousPropertyInfo = "MountOperation::anonymous" attrGet _ = getMountOperationAnonymous attrSet _ = setMountOperationAnonymous attrConstruct _ = constructMountOperationAnonymous -- VVV Prop "choice" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getMountOperationChoice :: (MonadIO m, MountOperationK o) => o -> m Int32 getMountOperationChoice obj = liftIO $ getObjectPropertyCInt obj "choice" setMountOperationChoice :: (MonadIO m, MountOperationK o) => o -> Int32 -> m () setMountOperationChoice obj val = liftIO $ setObjectPropertyCInt obj "choice" val constructMountOperationChoice :: Int32 -> IO ([Char], GValue) constructMountOperationChoice val = constructObjectPropertyCInt "choice" val data MountOperationChoicePropertyInfo instance AttrInfo MountOperationChoicePropertyInfo where type AttrAllowedOps MountOperationChoicePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationChoicePropertyInfo = (~) Int32 type AttrBaseTypeConstraint MountOperationChoicePropertyInfo = MountOperationK type AttrGetType MountOperationChoicePropertyInfo = Int32 type AttrLabel MountOperationChoicePropertyInfo = "MountOperation::choice" attrGet _ = getMountOperationChoice attrSet _ = setMountOperationChoice attrConstruct _ = constructMountOperationChoice -- VVV Prop "domain" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMountOperationDomain :: (MonadIO m, MountOperationK o) => o -> m T.Text getMountOperationDomain obj = liftIO $ getObjectPropertyString obj "domain" setMountOperationDomain :: (MonadIO m, MountOperationK o) => o -> T.Text -> m () setMountOperationDomain obj val = liftIO $ setObjectPropertyString obj "domain" val constructMountOperationDomain :: T.Text -> IO ([Char], GValue) constructMountOperationDomain val = constructObjectPropertyString "domain" val data MountOperationDomainPropertyInfo instance AttrInfo MountOperationDomainPropertyInfo where type AttrAllowedOps MountOperationDomainPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationDomainPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MountOperationDomainPropertyInfo = MountOperationK type AttrGetType MountOperationDomainPropertyInfo = T.Text type AttrLabel MountOperationDomainPropertyInfo = "MountOperation::domain" attrGet _ = getMountOperationDomain attrSet _ = setMountOperationDomain attrConstruct _ = constructMountOperationDomain -- VVV Prop "password" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMountOperationPassword :: (MonadIO m, MountOperationK o) => o -> m T.Text getMountOperationPassword obj = liftIO $ getObjectPropertyString obj "password" setMountOperationPassword :: (MonadIO m, MountOperationK o) => o -> T.Text -> m () setMountOperationPassword obj val = liftIO $ setObjectPropertyString obj "password" val constructMountOperationPassword :: T.Text -> IO ([Char], GValue) constructMountOperationPassword val = constructObjectPropertyString "password" val data MountOperationPasswordPropertyInfo instance AttrInfo MountOperationPasswordPropertyInfo where type AttrAllowedOps MountOperationPasswordPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationPasswordPropertyInfo = (~) T.Text type AttrBaseTypeConstraint MountOperationPasswordPropertyInfo = MountOperationK type AttrGetType MountOperationPasswordPropertyInfo = T.Text type AttrLabel MountOperationPasswordPropertyInfo = "MountOperation::password" attrGet _ = getMountOperationPassword attrSet _ = setMountOperationPassword attrConstruct _ = constructMountOperationPassword -- VVV Prop "password-save" -- Type: TInterface "Gio" "PasswordSave" -- Flags: [PropertyReadable,PropertyWritable] getMountOperationPasswordSave :: (MonadIO m, MountOperationK o) => o -> m PasswordSave getMountOperationPasswordSave obj = liftIO $ getObjectPropertyEnum obj "password-save" setMountOperationPasswordSave :: (MonadIO m, MountOperationK o) => o -> PasswordSave -> m () setMountOperationPasswordSave obj val = liftIO $ setObjectPropertyEnum obj "password-save" val constructMountOperationPasswordSave :: PasswordSave -> IO ([Char], GValue) constructMountOperationPasswordSave val = constructObjectPropertyEnum "password-save" val data MountOperationPasswordSavePropertyInfo instance AttrInfo MountOperationPasswordSavePropertyInfo where type AttrAllowedOps MountOperationPasswordSavePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationPasswordSavePropertyInfo = (~) PasswordSave type AttrBaseTypeConstraint MountOperationPasswordSavePropertyInfo = MountOperationK type AttrGetType MountOperationPasswordSavePropertyInfo = PasswordSave type AttrLabel MountOperationPasswordSavePropertyInfo = "MountOperation::password-save" attrGet _ = getMountOperationPasswordSave attrSet _ = setMountOperationPasswordSave attrConstruct _ = constructMountOperationPasswordSave -- VVV Prop "username" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getMountOperationUsername :: (MonadIO m, MountOperationK o) => o -> m T.Text getMountOperationUsername obj = liftIO $ getObjectPropertyString obj "username" setMountOperationUsername :: (MonadIO m, MountOperationK o) => o -> T.Text -> m () setMountOperationUsername obj val = liftIO $ setObjectPropertyString obj "username" val constructMountOperationUsername :: T.Text -> IO ([Char], GValue) constructMountOperationUsername val = constructObjectPropertyString "username" val data MountOperationUsernamePropertyInfo instance AttrInfo MountOperationUsernamePropertyInfo where type AttrAllowedOps MountOperationUsernamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint MountOperationUsernamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint MountOperationUsernamePropertyInfo = MountOperationK type AttrGetType MountOperationUsernamePropertyInfo = T.Text type AttrLabel MountOperationUsernamePropertyInfo = "MountOperation::username" attrGet _ = getMountOperationUsername attrSet _ = setMountOperationUsername attrConstruct _ = constructMountOperationUsername type instance AttributeList MountOperation = '[ '("anonymous", MountOperationAnonymousPropertyInfo), '("choice", MountOperationChoicePropertyInfo), '("domain", MountOperationDomainPropertyInfo), '("password", MountOperationPasswordPropertyInfo), '("password-save", MountOperationPasswordSavePropertyInfo), '("username", MountOperationUsernamePropertyInfo)] type instance AttributeList NativeVolumeMonitor = '[ ] -- VVV Prop "hostname" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getNetworkAddressHostname :: (MonadIO m, NetworkAddressK o) => o -> m T.Text getNetworkAddressHostname obj = liftIO $ getObjectPropertyString obj "hostname" constructNetworkAddressHostname :: T.Text -> IO ([Char], GValue) constructNetworkAddressHostname val = constructObjectPropertyString "hostname" val data NetworkAddressHostnamePropertyInfo instance AttrInfo NetworkAddressHostnamePropertyInfo where type AttrAllowedOps NetworkAddressHostnamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkAddressHostnamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NetworkAddressHostnamePropertyInfo = NetworkAddressK type AttrGetType NetworkAddressHostnamePropertyInfo = T.Text type AttrLabel NetworkAddressHostnamePropertyInfo = "NetworkAddress::hostname" attrGet _ = getNetworkAddressHostname attrSet _ = undefined attrConstruct _ = constructNetworkAddressHostname -- VVV Prop "port" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getNetworkAddressPort :: (MonadIO m, NetworkAddressK o) => o -> m Word32 getNetworkAddressPort obj = liftIO $ getObjectPropertyCUInt obj "port" constructNetworkAddressPort :: Word32 -> IO ([Char], GValue) constructNetworkAddressPort val = constructObjectPropertyCUInt "port" val data NetworkAddressPortPropertyInfo instance AttrInfo NetworkAddressPortPropertyInfo where type AttrAllowedOps NetworkAddressPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkAddressPortPropertyInfo = (~) Word32 type AttrBaseTypeConstraint NetworkAddressPortPropertyInfo = NetworkAddressK type AttrGetType NetworkAddressPortPropertyInfo = Word32 type AttrLabel NetworkAddressPortPropertyInfo = "NetworkAddress::port" attrGet _ = getNetworkAddressPort attrSet _ = undefined attrConstruct _ = constructNetworkAddressPort -- VVV Prop "scheme" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getNetworkAddressScheme :: (MonadIO m, NetworkAddressK o) => o -> m T.Text getNetworkAddressScheme obj = liftIO $ getObjectPropertyString obj "scheme" constructNetworkAddressScheme :: T.Text -> IO ([Char], GValue) constructNetworkAddressScheme val = constructObjectPropertyString "scheme" val data NetworkAddressSchemePropertyInfo instance AttrInfo NetworkAddressSchemePropertyInfo where type AttrAllowedOps NetworkAddressSchemePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkAddressSchemePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NetworkAddressSchemePropertyInfo = NetworkAddressK type AttrGetType NetworkAddressSchemePropertyInfo = T.Text type AttrLabel NetworkAddressSchemePropertyInfo = "NetworkAddress::scheme" attrGet _ = getNetworkAddressScheme attrSet _ = undefined attrConstruct _ = constructNetworkAddressScheme type instance AttributeList NetworkAddress = '[ '("hostname", NetworkAddressHostnamePropertyInfo), '("port", NetworkAddressPortPropertyInfo), '("scheme", NetworkAddressSchemePropertyInfo)] -- VVV Prop "connectivity" -- Type: TInterface "Gio" "NetworkConnectivity" -- Flags: [PropertyReadable] getNetworkMonitorConnectivity :: (MonadIO m, NetworkMonitorK o) => o -> m NetworkConnectivity getNetworkMonitorConnectivity obj = liftIO $ getObjectPropertyEnum obj "connectivity" data NetworkMonitorConnectivityPropertyInfo instance AttrInfo NetworkMonitorConnectivityPropertyInfo where type AttrAllowedOps NetworkMonitorConnectivityPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint NetworkMonitorConnectivityPropertyInfo = (~) () type AttrBaseTypeConstraint NetworkMonitorConnectivityPropertyInfo = NetworkMonitorK type AttrGetType NetworkMonitorConnectivityPropertyInfo = NetworkConnectivity type AttrLabel NetworkMonitorConnectivityPropertyInfo = "NetworkMonitor::connectivity" attrGet _ = getNetworkMonitorConnectivity attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "network-available" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getNetworkMonitorNetworkAvailable :: (MonadIO m, NetworkMonitorK o) => o -> m Bool getNetworkMonitorNetworkAvailable obj = liftIO $ getObjectPropertyBool obj "network-available" data NetworkMonitorNetworkAvailablePropertyInfo instance AttrInfo NetworkMonitorNetworkAvailablePropertyInfo where type AttrAllowedOps NetworkMonitorNetworkAvailablePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint NetworkMonitorNetworkAvailablePropertyInfo = (~) () type AttrBaseTypeConstraint NetworkMonitorNetworkAvailablePropertyInfo = NetworkMonitorK type AttrGetType NetworkMonitorNetworkAvailablePropertyInfo = Bool type AttrLabel NetworkMonitorNetworkAvailablePropertyInfo = "NetworkMonitor::network-available" attrGet _ = getNetworkMonitorNetworkAvailable attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList NetworkMonitor = '[ '("connectivity", NetworkMonitorConnectivityPropertyInfo), '("network-available", NetworkMonitorNetworkAvailablePropertyInfo)] -- VVV Prop "domain" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getNetworkServiceDomain :: (MonadIO m, NetworkServiceK o) => o -> m T.Text getNetworkServiceDomain obj = liftIO $ getObjectPropertyString obj "domain" constructNetworkServiceDomain :: T.Text -> IO ([Char], GValue) constructNetworkServiceDomain val = constructObjectPropertyString "domain" val data NetworkServiceDomainPropertyInfo instance AttrInfo NetworkServiceDomainPropertyInfo where type AttrAllowedOps NetworkServiceDomainPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkServiceDomainPropertyInfo = (~) T.Text type AttrBaseTypeConstraint NetworkServiceDomainPropertyInfo = NetworkServiceK type AttrGetType NetworkServiceDomainPropertyInfo = T.Text type AttrLabel NetworkServiceDomainPropertyInfo = "NetworkService::domain" attrGet _ = getNetworkServiceDomain attrSet _ = undefined attrConstruct _ = constructNetworkServiceDomain -- VVV Prop "protocol" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getNetworkServiceProtocol :: (MonadIO m, NetworkServiceK o) => o -> m T.Text getNetworkServiceProtocol obj = liftIO $ getObjectPropertyString obj "protocol" constructNetworkServiceProtocol :: T.Text -> IO ([Char], GValue) constructNetworkServiceProtocol val = constructObjectPropertyString "protocol" val data NetworkServiceProtocolPropertyInfo instance AttrInfo NetworkServiceProtocolPropertyInfo where type AttrAllowedOps NetworkServiceProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkServiceProtocolPropertyInfo = (~) T.Text type AttrBaseTypeConstraint NetworkServiceProtocolPropertyInfo = NetworkServiceK type AttrGetType NetworkServiceProtocolPropertyInfo = T.Text type AttrLabel NetworkServiceProtocolPropertyInfo = "NetworkService::protocol" attrGet _ = getNetworkServiceProtocol attrSet _ = undefined attrConstruct _ = constructNetworkServiceProtocol -- VVV Prop "scheme" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getNetworkServiceScheme :: (MonadIO m, NetworkServiceK o) => o -> m T.Text getNetworkServiceScheme obj = liftIO $ getObjectPropertyString obj "scheme" setNetworkServiceScheme :: (MonadIO m, NetworkServiceK o) => o -> T.Text -> m () setNetworkServiceScheme obj val = liftIO $ setObjectPropertyString obj "scheme" val constructNetworkServiceScheme :: T.Text -> IO ([Char], GValue) constructNetworkServiceScheme val = constructObjectPropertyString "scheme" val data NetworkServiceSchemePropertyInfo instance AttrInfo NetworkServiceSchemePropertyInfo where type AttrAllowedOps NetworkServiceSchemePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkServiceSchemePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NetworkServiceSchemePropertyInfo = NetworkServiceK type AttrGetType NetworkServiceSchemePropertyInfo = T.Text type AttrLabel NetworkServiceSchemePropertyInfo = "NetworkService::scheme" attrGet _ = getNetworkServiceScheme attrSet _ = setNetworkServiceScheme attrConstruct _ = constructNetworkServiceScheme -- VVV Prop "service" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getNetworkServiceService :: (MonadIO m, NetworkServiceK o) => o -> m T.Text getNetworkServiceService obj = liftIO $ getObjectPropertyString obj "service" constructNetworkServiceService :: T.Text -> IO ([Char], GValue) constructNetworkServiceService val = constructObjectPropertyString "service" val data NetworkServiceServicePropertyInfo instance AttrInfo NetworkServiceServicePropertyInfo where type AttrAllowedOps NetworkServiceServicePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint NetworkServiceServicePropertyInfo = (~) T.Text type AttrBaseTypeConstraint NetworkServiceServicePropertyInfo = NetworkServiceK type AttrGetType NetworkServiceServicePropertyInfo = T.Text type AttrLabel NetworkServiceServicePropertyInfo = "NetworkService::service" attrGet _ = getNetworkServiceService attrSet _ = undefined attrConstruct _ = constructNetworkServiceService type instance AttributeList NetworkService = '[ '("domain", NetworkServiceDomainPropertyInfo), '("protocol", NetworkServiceProtocolPropertyInfo), '("scheme", NetworkServiceSchemePropertyInfo), '("service", NetworkServiceServicePropertyInfo)] type instance AttributeList Notification = '[ ] type instance AttributeList OutputStream = '[ ] -- VVV Prop "allowed" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getPermissionAllowed :: (MonadIO m, PermissionK o) => o -> m Bool getPermissionAllowed obj = liftIO $ getObjectPropertyBool obj "allowed" data PermissionAllowedPropertyInfo instance AttrInfo PermissionAllowedPropertyInfo where type AttrAllowedOps PermissionAllowedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PermissionAllowedPropertyInfo = (~) () type AttrBaseTypeConstraint PermissionAllowedPropertyInfo = PermissionK type AttrGetType PermissionAllowedPropertyInfo = Bool type AttrLabel PermissionAllowedPropertyInfo = "Permission::allowed" attrGet _ = getPermissionAllowed attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "can-acquire" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getPermissionCanAcquire :: (MonadIO m, PermissionK o) => o -> m Bool getPermissionCanAcquire obj = liftIO $ getObjectPropertyBool obj "can-acquire" data PermissionCanAcquirePropertyInfo instance AttrInfo PermissionCanAcquirePropertyInfo where type AttrAllowedOps PermissionCanAcquirePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PermissionCanAcquirePropertyInfo = (~) () type AttrBaseTypeConstraint PermissionCanAcquirePropertyInfo = PermissionK type AttrGetType PermissionCanAcquirePropertyInfo = Bool type AttrLabel PermissionCanAcquirePropertyInfo = "Permission::can-acquire" attrGet _ = getPermissionCanAcquire attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "can-release" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getPermissionCanRelease :: (MonadIO m, PermissionK o) => o -> m Bool getPermissionCanRelease obj = liftIO $ getObjectPropertyBool obj "can-release" data PermissionCanReleasePropertyInfo instance AttrInfo PermissionCanReleasePropertyInfo where type AttrAllowedOps PermissionCanReleasePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PermissionCanReleasePropertyInfo = (~) () type AttrBaseTypeConstraint PermissionCanReleasePropertyInfo = PermissionK type AttrGetType PermissionCanReleasePropertyInfo = Bool type AttrLabel PermissionCanReleasePropertyInfo = "Permission::can-release" attrGet _ = getPermissionCanRelease attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList Permission = '[ '("allowed", PermissionAllowedPropertyInfo), '("can-acquire", PermissionCanAcquirePropertyInfo), '("can-release", PermissionCanReleasePropertyInfo)] type instance AttributeList PollableInputStream = '[ ] type instance AttributeList PollableOutputStream = '[ ] --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "PropertyAction"} -> Property {propName = "name", propType = TBasicType TUTF8, propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "Action"} -> Property {propName = "name", propType = TBasicType TUTF8, propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} -- VVV Prop "enabled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getPropertyActionEnabled :: (MonadIO m, PropertyActionK o) => o -> m Bool getPropertyActionEnabled obj = liftIO $ getObjectPropertyBool obj "enabled" data PropertyActionEnabledPropertyInfo instance AttrInfo PropertyActionEnabledPropertyInfo where type AttrAllowedOps PropertyActionEnabledPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PropertyActionEnabledPropertyInfo = (~) () type AttrBaseTypeConstraint PropertyActionEnabledPropertyInfo = PropertyActionK type AttrGetType PropertyActionEnabledPropertyInfo = Bool type AttrLabel PropertyActionEnabledPropertyInfo = "PropertyAction::enabled" attrGet _ = getPropertyActionEnabled attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getPropertyActionName :: (MonadIO m, PropertyActionK o) => o -> m T.Text getPropertyActionName obj = liftIO $ getObjectPropertyString obj "name" constructPropertyActionName :: T.Text -> IO ([Char], GValue) constructPropertyActionName val = constructObjectPropertyString "name" val data PropertyActionNamePropertyInfo instance AttrInfo PropertyActionNamePropertyInfo where type AttrAllowedOps PropertyActionNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint PropertyActionNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint PropertyActionNamePropertyInfo = PropertyActionK type AttrGetType PropertyActionNamePropertyInfo = T.Text type AttrLabel PropertyActionNamePropertyInfo = "PropertyAction::name" attrGet _ = getPropertyActionName attrSet _ = undefined attrConstruct _ = constructPropertyActionName -- VVV Prop "object" -- Type: TInterface "GObject" "Object" -- Flags: [PropertyWritable,PropertyConstructOnly] constructPropertyActionObject :: (GObject.ObjectK a) => a -> IO ([Char], GValue) constructPropertyActionObject val = constructObjectPropertyObject "object" val data PropertyActionObjectPropertyInfo instance AttrInfo PropertyActionObjectPropertyInfo where type AttrAllowedOps PropertyActionObjectPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint PropertyActionObjectPropertyInfo = GObject.ObjectK type AttrBaseTypeConstraint PropertyActionObjectPropertyInfo = PropertyActionK type AttrGetType PropertyActionObjectPropertyInfo = () type AttrLabel PropertyActionObjectPropertyInfo = "PropertyAction::object" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructPropertyActionObject -- VVV Prop "parameter-type" -- Type: TInterface "GLib" "VariantType" -- Flags: [PropertyReadable] getPropertyActionParameterType :: (MonadIO m, PropertyActionK o) => o -> m GLib.VariantType getPropertyActionParameterType obj = liftIO $ getObjectPropertyBoxed obj "parameter-type" GLib.VariantType data PropertyActionParameterTypePropertyInfo instance AttrInfo PropertyActionParameterTypePropertyInfo where type AttrAllowedOps PropertyActionParameterTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PropertyActionParameterTypePropertyInfo = (~) () type AttrBaseTypeConstraint PropertyActionParameterTypePropertyInfo = PropertyActionK type AttrGetType PropertyActionParameterTypePropertyInfo = GLib.VariantType type AttrLabel PropertyActionParameterTypePropertyInfo = "PropertyAction::parameter-type" attrGet _ = getPropertyActionParameterType attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "property-name" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable,PropertyConstructOnly] constructPropertyActionPropertyName :: T.Text -> IO ([Char], GValue) constructPropertyActionPropertyName val = constructObjectPropertyString "property-name" val data PropertyActionPropertyNamePropertyInfo instance AttrInfo PropertyActionPropertyNamePropertyInfo where type AttrAllowedOps PropertyActionPropertyNamePropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint PropertyActionPropertyNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint PropertyActionPropertyNamePropertyInfo = PropertyActionK type AttrGetType PropertyActionPropertyNamePropertyInfo = () type AttrLabel PropertyActionPropertyNamePropertyInfo = "PropertyAction::property-name" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructPropertyActionPropertyName -- VVV Prop "state" -- Type: TVariant -- Flags: [PropertyReadable] getPropertyActionState :: (MonadIO m, PropertyActionK o) => o -> m GVariant getPropertyActionState obj = liftIO $ getObjectPropertyVariant obj "state" data PropertyActionStatePropertyInfo instance AttrInfo PropertyActionStatePropertyInfo where type AttrAllowedOps PropertyActionStatePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PropertyActionStatePropertyInfo = (~) () type AttrBaseTypeConstraint PropertyActionStatePropertyInfo = PropertyActionK type AttrGetType PropertyActionStatePropertyInfo = GVariant type AttrLabel PropertyActionStatePropertyInfo = "PropertyAction::state" attrGet _ = getPropertyActionState attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "state-type" -- Type: TInterface "GLib" "VariantType" -- Flags: [PropertyReadable] getPropertyActionStateType :: (MonadIO m, PropertyActionK o) => o -> m GLib.VariantType getPropertyActionStateType obj = liftIO $ getObjectPropertyBoxed obj "state-type" GLib.VariantType data PropertyActionStateTypePropertyInfo instance AttrInfo PropertyActionStateTypePropertyInfo where type AttrAllowedOps PropertyActionStateTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint PropertyActionStateTypePropertyInfo = (~) () type AttrBaseTypeConstraint PropertyActionStateTypePropertyInfo = PropertyActionK type AttrGetType PropertyActionStateTypePropertyInfo = GLib.VariantType type AttrLabel PropertyActionStateTypePropertyInfo = "PropertyAction::state-type" attrGet _ = getPropertyActionStateType attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList PropertyAction = '[ '("enabled", PropertyActionEnabledPropertyInfo), '("object", PropertyActionObjectPropertyInfo), '("parameter-type", PropertyActionParameterTypePropertyInfo), '("property-name", PropertyActionPropertyNamePropertyInfo), '("state", PropertyActionStatePropertyInfo), '("state-type", PropertyActionStateTypePropertyInfo)] type instance AttributeList Proxy = '[ ] -- VVV Prop "destination-hostname" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressDestinationHostname :: (MonadIO m, ProxyAddressK o) => o -> m T.Text getProxyAddressDestinationHostname obj = liftIO $ getObjectPropertyString obj "destination-hostname" constructProxyAddressDestinationHostname :: T.Text -> IO ([Char], GValue) constructProxyAddressDestinationHostname val = constructObjectPropertyString "destination-hostname" val data ProxyAddressDestinationHostnamePropertyInfo instance AttrInfo ProxyAddressDestinationHostnamePropertyInfo where type AttrAllowedOps ProxyAddressDestinationHostnamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressDestinationHostnamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressDestinationHostnamePropertyInfo = ProxyAddressK type AttrGetType ProxyAddressDestinationHostnamePropertyInfo = T.Text type AttrLabel ProxyAddressDestinationHostnamePropertyInfo = "ProxyAddress::destination-hostname" attrGet _ = getProxyAddressDestinationHostname attrSet _ = undefined attrConstruct _ = constructProxyAddressDestinationHostname -- VVV Prop "destination-port" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressDestinationPort :: (MonadIO m, ProxyAddressK o) => o -> m Word32 getProxyAddressDestinationPort obj = liftIO $ getObjectPropertyCUInt obj "destination-port" constructProxyAddressDestinationPort :: Word32 -> IO ([Char], GValue) constructProxyAddressDestinationPort val = constructObjectPropertyCUInt "destination-port" val data ProxyAddressDestinationPortPropertyInfo instance AttrInfo ProxyAddressDestinationPortPropertyInfo where type AttrAllowedOps ProxyAddressDestinationPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressDestinationPortPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ProxyAddressDestinationPortPropertyInfo = ProxyAddressK type AttrGetType ProxyAddressDestinationPortPropertyInfo = Word32 type AttrLabel ProxyAddressDestinationPortPropertyInfo = "ProxyAddress::destination-port" attrGet _ = getProxyAddressDestinationPort attrSet _ = undefined attrConstruct _ = constructProxyAddressDestinationPort -- VVV Prop "destination-protocol" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressDestinationProtocol :: (MonadIO m, ProxyAddressK o) => o -> m T.Text getProxyAddressDestinationProtocol obj = liftIO $ getObjectPropertyString obj "destination-protocol" constructProxyAddressDestinationProtocol :: T.Text -> IO ([Char], GValue) constructProxyAddressDestinationProtocol val = constructObjectPropertyString "destination-protocol" val data ProxyAddressDestinationProtocolPropertyInfo instance AttrInfo ProxyAddressDestinationProtocolPropertyInfo where type AttrAllowedOps ProxyAddressDestinationProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressDestinationProtocolPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressDestinationProtocolPropertyInfo = ProxyAddressK type AttrGetType ProxyAddressDestinationProtocolPropertyInfo = T.Text type AttrLabel ProxyAddressDestinationProtocolPropertyInfo = "ProxyAddress::destination-protocol" attrGet _ = getProxyAddressDestinationProtocol attrSet _ = undefined attrConstruct _ = constructProxyAddressDestinationProtocol -- VVV Prop "password" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressPassword :: (MonadIO m, ProxyAddressK o) => o -> m T.Text getProxyAddressPassword obj = liftIO $ getObjectPropertyString obj "password" constructProxyAddressPassword :: T.Text -> IO ([Char], GValue) constructProxyAddressPassword val = constructObjectPropertyString "password" val data ProxyAddressPasswordPropertyInfo instance AttrInfo ProxyAddressPasswordPropertyInfo where type AttrAllowedOps ProxyAddressPasswordPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressPasswordPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressPasswordPropertyInfo = ProxyAddressK type AttrGetType ProxyAddressPasswordPropertyInfo = T.Text type AttrLabel ProxyAddressPasswordPropertyInfo = "ProxyAddress::password" attrGet _ = getProxyAddressPassword attrSet _ = undefined attrConstruct _ = constructProxyAddressPassword -- VVV Prop "protocol" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressProtocol :: (MonadIO m, ProxyAddressK o) => o -> m T.Text getProxyAddressProtocol obj = liftIO $ getObjectPropertyString obj "protocol" constructProxyAddressProtocol :: T.Text -> IO ([Char], GValue) constructProxyAddressProtocol val = constructObjectPropertyString "protocol" val data ProxyAddressProtocolPropertyInfo instance AttrInfo ProxyAddressProtocolPropertyInfo where type AttrAllowedOps ProxyAddressProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressProtocolPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressProtocolPropertyInfo = ProxyAddressK type AttrGetType ProxyAddressProtocolPropertyInfo = T.Text type AttrLabel ProxyAddressProtocolPropertyInfo = "ProxyAddress::protocol" attrGet _ = getProxyAddressProtocol attrSet _ = undefined attrConstruct _ = constructProxyAddressProtocol -- VVV Prop "uri" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressUri :: (MonadIO m, ProxyAddressK o) => o -> m T.Text getProxyAddressUri obj = liftIO $ getObjectPropertyString obj "uri" constructProxyAddressUri :: T.Text -> IO ([Char], GValue) constructProxyAddressUri val = constructObjectPropertyString "uri" val data ProxyAddressUriPropertyInfo instance AttrInfo ProxyAddressUriPropertyInfo where type AttrAllowedOps ProxyAddressUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressUriPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressUriPropertyInfo = ProxyAddressK type AttrGetType ProxyAddressUriPropertyInfo = T.Text type AttrLabel ProxyAddressUriPropertyInfo = "ProxyAddress::uri" attrGet _ = getProxyAddressUri attrSet _ = undefined attrConstruct _ = constructProxyAddressUri -- VVV Prop "username" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressUsername :: (MonadIO m, ProxyAddressK o) => o -> m T.Text getProxyAddressUsername obj = liftIO $ getObjectPropertyString obj "username" constructProxyAddressUsername :: T.Text -> IO ([Char], GValue) constructProxyAddressUsername val = constructObjectPropertyString "username" val data ProxyAddressUsernamePropertyInfo instance AttrInfo ProxyAddressUsernamePropertyInfo where type AttrAllowedOps ProxyAddressUsernamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressUsernamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressUsernamePropertyInfo = ProxyAddressK type AttrGetType ProxyAddressUsernamePropertyInfo = T.Text type AttrLabel ProxyAddressUsernamePropertyInfo = "ProxyAddress::username" attrGet _ = getProxyAddressUsername attrSet _ = undefined attrConstruct _ = constructProxyAddressUsername type instance AttributeList ProxyAddress = '[ '("address", InetSocketAddressAddressPropertyInfo), '("destination-hostname", ProxyAddressDestinationHostnamePropertyInfo), '("destination-port", ProxyAddressDestinationPortPropertyInfo), '("destination-protocol", ProxyAddressDestinationProtocolPropertyInfo), '("family", SocketAddressFamilyPropertyInfo), '("flowinfo", InetSocketAddressFlowinfoPropertyInfo), '("password", ProxyAddressPasswordPropertyInfo), '("port", InetSocketAddressPortPropertyInfo), '("protocol", ProxyAddressProtocolPropertyInfo), '("scope-id", InetSocketAddressScopeIdPropertyInfo), '("uri", ProxyAddressUriPropertyInfo), '("username", ProxyAddressUsernamePropertyInfo)] -- VVV Prop "connectable" -- Type: TInterface "Gio" "SocketConnectable" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressEnumeratorConnectable :: (MonadIO m, ProxyAddressEnumeratorK o) => o -> m SocketConnectable getProxyAddressEnumeratorConnectable obj = liftIO $ getObjectPropertyObject obj "connectable" SocketConnectable constructProxyAddressEnumeratorConnectable :: (SocketConnectableK a) => a -> IO ([Char], GValue) constructProxyAddressEnumeratorConnectable val = constructObjectPropertyObject "connectable" val data ProxyAddressEnumeratorConnectablePropertyInfo instance AttrInfo ProxyAddressEnumeratorConnectablePropertyInfo where type AttrAllowedOps ProxyAddressEnumeratorConnectablePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressEnumeratorConnectablePropertyInfo = SocketConnectableK type AttrBaseTypeConstraint ProxyAddressEnumeratorConnectablePropertyInfo = ProxyAddressEnumeratorK type AttrGetType ProxyAddressEnumeratorConnectablePropertyInfo = SocketConnectable type AttrLabel ProxyAddressEnumeratorConnectablePropertyInfo = "ProxyAddressEnumerator::connectable" attrGet _ = getProxyAddressEnumeratorConnectable attrSet _ = undefined attrConstruct _ = constructProxyAddressEnumeratorConnectable -- VVV Prop "default-port" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressEnumeratorDefaultPort :: (MonadIO m, ProxyAddressEnumeratorK o) => o -> m Word32 getProxyAddressEnumeratorDefaultPort obj = liftIO $ getObjectPropertyCUInt obj "default-port" constructProxyAddressEnumeratorDefaultPort :: Word32 -> IO ([Char], GValue) constructProxyAddressEnumeratorDefaultPort val = constructObjectPropertyCUInt "default-port" val data ProxyAddressEnumeratorDefaultPortPropertyInfo instance AttrInfo ProxyAddressEnumeratorDefaultPortPropertyInfo where type AttrAllowedOps ProxyAddressEnumeratorDefaultPortPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressEnumeratorDefaultPortPropertyInfo = (~) Word32 type AttrBaseTypeConstraint ProxyAddressEnumeratorDefaultPortPropertyInfo = ProxyAddressEnumeratorK type AttrGetType ProxyAddressEnumeratorDefaultPortPropertyInfo = Word32 type AttrLabel ProxyAddressEnumeratorDefaultPortPropertyInfo = "ProxyAddressEnumerator::default-port" attrGet _ = getProxyAddressEnumeratorDefaultPort attrSet _ = undefined attrConstruct _ = constructProxyAddressEnumeratorDefaultPort -- VVV Prop "proxy-resolver" -- Type: TInterface "Gio" "ProxyResolver" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getProxyAddressEnumeratorProxyResolver :: (MonadIO m, ProxyAddressEnumeratorK o) => o -> m ProxyResolver getProxyAddressEnumeratorProxyResolver obj = liftIO $ getObjectPropertyObject obj "proxy-resolver" ProxyResolver setProxyAddressEnumeratorProxyResolver :: (MonadIO m, ProxyAddressEnumeratorK o, ProxyResolverK a) => o -> a -> m () setProxyAddressEnumeratorProxyResolver obj val = liftIO $ setObjectPropertyObject obj "proxy-resolver" val constructProxyAddressEnumeratorProxyResolver :: (ProxyResolverK a) => a -> IO ([Char], GValue) constructProxyAddressEnumeratorProxyResolver val = constructObjectPropertyObject "proxy-resolver" val data ProxyAddressEnumeratorProxyResolverPropertyInfo instance AttrInfo ProxyAddressEnumeratorProxyResolverPropertyInfo where type AttrAllowedOps ProxyAddressEnumeratorProxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressEnumeratorProxyResolverPropertyInfo = ProxyResolverK type AttrBaseTypeConstraint ProxyAddressEnumeratorProxyResolverPropertyInfo = ProxyAddressEnumeratorK type AttrGetType ProxyAddressEnumeratorProxyResolverPropertyInfo = ProxyResolver type AttrLabel ProxyAddressEnumeratorProxyResolverPropertyInfo = "ProxyAddressEnumerator::proxy-resolver" attrGet _ = getProxyAddressEnumeratorProxyResolver attrSet _ = setProxyAddressEnumeratorProxyResolver attrConstruct _ = constructProxyAddressEnumeratorProxyResolver -- VVV Prop "uri" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getProxyAddressEnumeratorUri :: (MonadIO m, ProxyAddressEnumeratorK o) => o -> m T.Text getProxyAddressEnumeratorUri obj = liftIO $ getObjectPropertyString obj "uri" constructProxyAddressEnumeratorUri :: T.Text -> IO ([Char], GValue) constructProxyAddressEnumeratorUri val = constructObjectPropertyString "uri" val data ProxyAddressEnumeratorUriPropertyInfo instance AttrInfo ProxyAddressEnumeratorUriPropertyInfo where type AttrAllowedOps ProxyAddressEnumeratorUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ProxyAddressEnumeratorUriPropertyInfo = (~) T.Text type AttrBaseTypeConstraint ProxyAddressEnumeratorUriPropertyInfo = ProxyAddressEnumeratorK type AttrGetType ProxyAddressEnumeratorUriPropertyInfo = T.Text type AttrLabel ProxyAddressEnumeratorUriPropertyInfo = "ProxyAddressEnumerator::uri" attrGet _ = getProxyAddressEnumeratorUri attrSet _ = undefined attrConstruct _ = constructProxyAddressEnumeratorUri type instance AttributeList ProxyAddressEnumerator = '[ '("connectable", ProxyAddressEnumeratorConnectablePropertyInfo), '("default-port", ProxyAddressEnumeratorDefaultPortPropertyInfo), '("proxy-resolver", ProxyAddressEnumeratorProxyResolverPropertyInfo), '("uri", ProxyAddressEnumeratorUriPropertyInfo)] type instance AttributeList ProxyResolver = '[ ] type instance AttributeList RemoteActionGroup = '[ ] type instance AttributeList Resolver = '[ ] type instance AttributeList Seekable = '[ ] -- VVV Prop "delay-apply" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getSettingsDelayApply :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsDelayApply obj = liftIO $ getObjectPropertyBool obj "delay-apply" data SettingsDelayApplyPropertyInfo instance AttrInfo SettingsDelayApplyPropertyInfo where type AttrAllowedOps SettingsDelayApplyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SettingsDelayApplyPropertyInfo = (~) () type AttrBaseTypeConstraint SettingsDelayApplyPropertyInfo = SettingsK type AttrGetType SettingsDelayApplyPropertyInfo = Bool type AttrLabel SettingsDelayApplyPropertyInfo = "Settings::delay-apply" attrGet _ = getSettingsDelayApply attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "has-unapplied" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getSettingsHasUnapplied :: (MonadIO m, SettingsK o) => o -> m Bool getSettingsHasUnapplied obj = liftIO $ getObjectPropertyBool obj "has-unapplied" data SettingsHasUnappliedPropertyInfo instance AttrInfo SettingsHasUnappliedPropertyInfo where type AttrAllowedOps SettingsHasUnappliedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SettingsHasUnappliedPropertyInfo = (~) () type AttrBaseTypeConstraint SettingsHasUnappliedPropertyInfo = SettingsK type AttrGetType SettingsHasUnappliedPropertyInfo = Bool type AttrLabel SettingsHasUnappliedPropertyInfo = "Settings::has-unapplied" attrGet _ = getSettingsHasUnapplied attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSettingsPath :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsPath obj = liftIO $ getObjectPropertyString obj "path" constructSettingsPath :: T.Text -> IO ([Char], GValue) constructSettingsPath val = constructObjectPropertyString "path" val data SettingsPathPropertyInfo instance AttrInfo SettingsPathPropertyInfo where type AttrAllowedOps SettingsPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsPathPropertyInfo = SettingsK type AttrGetType SettingsPathPropertyInfo = T.Text type AttrLabel SettingsPathPropertyInfo = "Settings::path" attrGet _ = getSettingsPath attrSet _ = undefined attrConstruct _ = constructSettingsPath -- VVV Prop "schema" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSettingsSchema :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsSchema obj = liftIO $ getObjectPropertyString obj "schema" constructSettingsSchema :: T.Text -> IO ([Char], GValue) constructSettingsSchema val = constructObjectPropertyString "schema" val data SettingsSchemaPropertyInfo instance AttrInfo SettingsSchemaPropertyInfo where type AttrAllowedOps SettingsSchemaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsSchemaPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsSchemaPropertyInfo = SettingsK type AttrGetType SettingsSchemaPropertyInfo = T.Text type AttrLabel SettingsSchemaPropertyInfo = "Settings::schema" attrGet _ = getSettingsSchema attrSet _ = undefined attrConstruct _ = constructSettingsSchema -- VVV Prop "schema-id" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSettingsSchemaId :: (MonadIO m, SettingsK o) => o -> m T.Text getSettingsSchemaId obj = liftIO $ getObjectPropertyString obj "schema-id" constructSettingsSchemaId :: T.Text -> IO ([Char], GValue) constructSettingsSchemaId val = constructObjectPropertyString "schema-id" val data SettingsSchemaIdPropertyInfo instance AttrInfo SettingsSchemaIdPropertyInfo where type AttrAllowedOps SettingsSchemaIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsSchemaIdPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SettingsSchemaIdPropertyInfo = SettingsK type AttrGetType SettingsSchemaIdPropertyInfo = T.Text type AttrLabel SettingsSchemaIdPropertyInfo = "Settings::schema-id" attrGet _ = getSettingsSchemaId attrSet _ = undefined attrConstruct _ = constructSettingsSchemaId -- VVV Prop "settings-schema" -- Type: TInterface "Gio" "SettingsSchema" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSettingsSettingsSchema :: (MonadIO m, SettingsK o) => o -> m SettingsSchema getSettingsSettingsSchema obj = liftIO $ getObjectPropertyBoxed obj "settings-schema" SettingsSchema constructSettingsSettingsSchema :: SettingsSchema -> IO ([Char], GValue) constructSettingsSettingsSchema val = constructObjectPropertyBoxed "settings-schema" val data SettingsSettingsSchemaPropertyInfo instance AttrInfo SettingsSettingsSchemaPropertyInfo where type AttrAllowedOps SettingsSettingsSchemaPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SettingsSettingsSchemaPropertyInfo = (~) SettingsSchema type AttrBaseTypeConstraint SettingsSettingsSchemaPropertyInfo = SettingsK type AttrGetType SettingsSettingsSchemaPropertyInfo = SettingsSchema type AttrLabel SettingsSettingsSchemaPropertyInfo = "Settings::settings-schema" attrGet _ = getSettingsSettingsSchema attrSet _ = undefined attrConstruct _ = constructSettingsSettingsSchema type instance AttributeList Settings = '[ '("delay-apply", SettingsDelayApplyPropertyInfo), '("has-unapplied", SettingsHasUnappliedPropertyInfo), '("path", SettingsPathPropertyInfo), '("schema", SettingsSchemaPropertyInfo), '("schema-id", SettingsSchemaIdPropertyInfo), '("settings-schema", SettingsSettingsSchemaPropertyInfo)] --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "SimpleAction"} -> Property {propName = "enabled", propType = TBasicType TBoolean, propFlags = [PropertyReadable,PropertyWritable], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "Action"} -> Property {propName = "enabled", propType = TBasicType TBoolean, propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "SimpleAction"} -> Property {propName = "name", propType = TBasicType TUTF8, propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "Action"} -> Property {propName = "name", propType = TBasicType TUTF8, propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "SimpleAction"} -> Property {propName = "parameter-type", propType = TInterface "GLib" "VariantType", propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "Action"} -> Property {propName = "parameter-type", propType = TInterface "GLib" "VariantType", propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "SimpleAction"} -> Property {propName = "state", propType = TVariant, propFlags = [PropertyReadable,PropertyWritable,PropertyConstruct], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "Action"} -> Property {propName = "state", propType = TVariant, propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} -- VVV Prop "enabled" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSimpleActionEnabled :: (MonadIO m, SimpleActionK o) => o -> m Bool getSimpleActionEnabled obj = liftIO $ getObjectPropertyBool obj "enabled" setSimpleActionEnabled :: (MonadIO m, SimpleActionK o) => o -> Bool -> m () setSimpleActionEnabled obj val = liftIO $ setObjectPropertyBool obj "enabled" val constructSimpleActionEnabled :: Bool -> IO ([Char], GValue) constructSimpleActionEnabled val = constructObjectPropertyBool "enabled" val data SimpleActionEnabledPropertyInfo instance AttrInfo SimpleActionEnabledPropertyInfo where type AttrAllowedOps SimpleActionEnabledPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleActionEnabledPropertyInfo = (~) Bool type AttrBaseTypeConstraint SimpleActionEnabledPropertyInfo = SimpleActionK type AttrGetType SimpleActionEnabledPropertyInfo = Bool type AttrLabel SimpleActionEnabledPropertyInfo = "SimpleAction::enabled" attrGet _ = getSimpleActionEnabled attrSet _ = setSimpleActionEnabled attrConstruct _ = constructSimpleActionEnabled -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSimpleActionName :: (MonadIO m, SimpleActionK o) => o -> m T.Text getSimpleActionName obj = liftIO $ getObjectPropertyString obj "name" constructSimpleActionName :: T.Text -> IO ([Char], GValue) constructSimpleActionName val = constructObjectPropertyString "name" val data SimpleActionNamePropertyInfo instance AttrInfo SimpleActionNamePropertyInfo where type AttrAllowedOps SimpleActionNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleActionNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint SimpleActionNamePropertyInfo = SimpleActionK type AttrGetType SimpleActionNamePropertyInfo = T.Text type AttrLabel SimpleActionNamePropertyInfo = "SimpleAction::name" attrGet _ = getSimpleActionName attrSet _ = undefined attrConstruct _ = constructSimpleActionName -- VVV Prop "parameter-type" -- Type: TInterface "GLib" "VariantType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSimpleActionParameterType :: (MonadIO m, SimpleActionK o) => o -> m GLib.VariantType getSimpleActionParameterType obj = liftIO $ getObjectPropertyBoxed obj "parameter-type" GLib.VariantType constructSimpleActionParameterType :: GLib.VariantType -> IO ([Char], GValue) constructSimpleActionParameterType val = constructObjectPropertyBoxed "parameter-type" val data SimpleActionParameterTypePropertyInfo instance AttrInfo SimpleActionParameterTypePropertyInfo where type AttrAllowedOps SimpleActionParameterTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleActionParameterTypePropertyInfo = (~) GLib.VariantType type AttrBaseTypeConstraint SimpleActionParameterTypePropertyInfo = SimpleActionK type AttrGetType SimpleActionParameterTypePropertyInfo = GLib.VariantType type AttrLabel SimpleActionParameterTypePropertyInfo = "SimpleAction::parameter-type" attrGet _ = getSimpleActionParameterType attrSet _ = undefined attrConstruct _ = constructSimpleActionParameterType -- VVV Prop "state" -- Type: TVariant -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSimpleActionState :: (MonadIO m, SimpleActionK o) => o -> m GVariant getSimpleActionState obj = liftIO $ getObjectPropertyVariant obj "state" setSimpleActionState :: (MonadIO m, SimpleActionK o) => o -> GVariant -> m () setSimpleActionState obj val = liftIO $ setObjectPropertyVariant obj "state" val constructSimpleActionState :: GVariant -> IO ([Char], GValue) constructSimpleActionState val = constructObjectPropertyVariant "state" val data SimpleActionStatePropertyInfo instance AttrInfo SimpleActionStatePropertyInfo where type AttrAllowedOps SimpleActionStatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleActionStatePropertyInfo = (~) GVariant type AttrBaseTypeConstraint SimpleActionStatePropertyInfo = SimpleActionK type AttrGetType SimpleActionStatePropertyInfo = GVariant type AttrLabel SimpleActionStatePropertyInfo = "SimpleAction::state" attrGet _ = getSimpleActionState attrSet _ = setSimpleActionState attrConstruct _ = constructSimpleActionState -- VVV Prop "state-type" -- Type: TInterface "GLib" "VariantType" -- Flags: [PropertyReadable] getSimpleActionStateType :: (MonadIO m, SimpleActionK o) => o -> m GLib.VariantType getSimpleActionStateType obj = liftIO $ getObjectPropertyBoxed obj "state-type" GLib.VariantType data SimpleActionStateTypePropertyInfo instance AttrInfo SimpleActionStateTypePropertyInfo where type AttrAllowedOps SimpleActionStateTypePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SimpleActionStateTypePropertyInfo = (~) () type AttrBaseTypeConstraint SimpleActionStateTypePropertyInfo = SimpleActionK type AttrGetType SimpleActionStateTypePropertyInfo = GLib.VariantType type AttrLabel SimpleActionStateTypePropertyInfo = "SimpleAction::state-type" attrGet _ = getSimpleActionStateType attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList SimpleAction = '[ '("state-type", SimpleActionStateTypePropertyInfo)] type instance AttributeList SimpleActionGroup = '[ ] type instance AttributeList SimpleAsyncResult = '[ ] --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "SimpleIOStream"} -> Property {propName = "input-stream", propType = TInterface "Gio" "InputStream", propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "IOStream"} -> Property {propName = "input-stream", propType = TInterface "Gio" "InputStream", propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} --- XXX Duplicated object with different types: --- Name {namespace = "Gio", name = "SimpleIOStream"} -> Property {propName = "output-stream", propType = TInterface "Gio" "OutputStream", propFlags = [PropertyReadable,PropertyWritable,PropertyConstructOnly], propTransfer = TransferNothing, propDeprecated = Nothing} --- Name {namespace = "Gio", name = "IOStream"} -> Property {propName = "output-stream", propType = TInterface "Gio" "OutputStream", propFlags = [PropertyReadable], propTransfer = TransferNothing, propDeprecated = Nothing} -- VVV Prop "input-stream" -- Type: TInterface "Gio" "InputStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSimpleIOStreamInputStream :: (MonadIO m, SimpleIOStreamK o) => o -> m InputStream getSimpleIOStreamInputStream obj = liftIO $ getObjectPropertyObject obj "input-stream" InputStream constructSimpleIOStreamInputStream :: (InputStreamK a) => a -> IO ([Char], GValue) constructSimpleIOStreamInputStream val = constructObjectPropertyObject "input-stream" val data SimpleIOStreamInputStreamPropertyInfo instance AttrInfo SimpleIOStreamInputStreamPropertyInfo where type AttrAllowedOps SimpleIOStreamInputStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleIOStreamInputStreamPropertyInfo = InputStreamK type AttrBaseTypeConstraint SimpleIOStreamInputStreamPropertyInfo = SimpleIOStreamK type AttrGetType SimpleIOStreamInputStreamPropertyInfo = InputStream type AttrLabel SimpleIOStreamInputStreamPropertyInfo = "SimpleIOStream::input-stream" attrGet _ = getSimpleIOStreamInputStream attrSet _ = undefined attrConstruct _ = constructSimpleIOStreamInputStream -- VVV Prop "output-stream" -- Type: TInterface "Gio" "OutputStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSimpleIOStreamOutputStream :: (MonadIO m, SimpleIOStreamK o) => o -> m OutputStream getSimpleIOStreamOutputStream obj = liftIO $ getObjectPropertyObject obj "output-stream" OutputStream constructSimpleIOStreamOutputStream :: (OutputStreamK a) => a -> IO ([Char], GValue) constructSimpleIOStreamOutputStream val = constructObjectPropertyObject "output-stream" val data SimpleIOStreamOutputStreamPropertyInfo instance AttrInfo SimpleIOStreamOutputStreamPropertyInfo where type AttrAllowedOps SimpleIOStreamOutputStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleIOStreamOutputStreamPropertyInfo = OutputStreamK type AttrBaseTypeConstraint SimpleIOStreamOutputStreamPropertyInfo = SimpleIOStreamK type AttrGetType SimpleIOStreamOutputStreamPropertyInfo = OutputStream type AttrLabel SimpleIOStreamOutputStreamPropertyInfo = "SimpleIOStream::output-stream" attrGet _ = getSimpleIOStreamOutputStream attrSet _ = undefined attrConstruct _ = constructSimpleIOStreamOutputStream type instance AttributeList SimpleIOStream = '[ '("closed", IOStreamClosedPropertyInfo)] type instance AttributeList SimplePermission = '[ '("allowed", PermissionAllowedPropertyInfo), '("can-acquire", PermissionCanAcquirePropertyInfo), '("can-release", PermissionCanReleasePropertyInfo)] -- VVV Prop "default-proxy" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getSimpleProxyResolverDefaultProxy :: (MonadIO m, SimpleProxyResolverK o) => o -> m T.Text getSimpleProxyResolverDefaultProxy obj = liftIO $ getObjectPropertyString obj "default-proxy" setSimpleProxyResolverDefaultProxy :: (MonadIO m, SimpleProxyResolverK o) => o -> T.Text -> m () setSimpleProxyResolverDefaultProxy obj val = liftIO $ setObjectPropertyString obj "default-proxy" val constructSimpleProxyResolverDefaultProxy :: T.Text -> IO ([Char], GValue) constructSimpleProxyResolverDefaultProxy val = constructObjectPropertyString "default-proxy" val data SimpleProxyResolverDefaultProxyPropertyInfo instance AttrInfo SimpleProxyResolverDefaultProxyPropertyInfo where type AttrAllowedOps SimpleProxyResolverDefaultProxyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleProxyResolverDefaultProxyPropertyInfo = (~) T.Text type AttrBaseTypeConstraint SimpleProxyResolverDefaultProxyPropertyInfo = SimpleProxyResolverK type AttrGetType SimpleProxyResolverDefaultProxyPropertyInfo = T.Text type AttrLabel SimpleProxyResolverDefaultProxyPropertyInfo = "SimpleProxyResolver::default-proxy" attrGet _ = getSimpleProxyResolverDefaultProxy attrSet _ = setSimpleProxyResolverDefaultProxy attrConstruct _ = constructSimpleProxyResolverDefaultProxy -- VVV Prop "ignore-hosts" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable] getSimpleProxyResolverIgnoreHosts :: (MonadIO m, SimpleProxyResolverK o) => o -> m [T.Text] getSimpleProxyResolverIgnoreHosts obj = liftIO $ getObjectPropertyStringArray obj "ignore-hosts" setSimpleProxyResolverIgnoreHosts :: (MonadIO m, SimpleProxyResolverK o) => o -> [T.Text] -> m () setSimpleProxyResolverIgnoreHosts obj val = liftIO $ setObjectPropertyStringArray obj "ignore-hosts" val constructSimpleProxyResolverIgnoreHosts :: [T.Text] -> IO ([Char], GValue) constructSimpleProxyResolverIgnoreHosts val = constructObjectPropertyStringArray "ignore-hosts" val data SimpleProxyResolverIgnoreHostsPropertyInfo instance AttrInfo SimpleProxyResolverIgnoreHostsPropertyInfo where type AttrAllowedOps SimpleProxyResolverIgnoreHostsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SimpleProxyResolverIgnoreHostsPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint SimpleProxyResolverIgnoreHostsPropertyInfo = SimpleProxyResolverK type AttrGetType SimpleProxyResolverIgnoreHostsPropertyInfo = [T.Text] type AttrLabel SimpleProxyResolverIgnoreHostsPropertyInfo = "SimpleProxyResolver::ignore-hosts" attrGet _ = getSimpleProxyResolverIgnoreHosts attrSet _ = setSimpleProxyResolverIgnoreHosts attrConstruct _ = constructSimpleProxyResolverIgnoreHosts type instance AttributeList SimpleProxyResolver = '[ '("default-proxy", SimpleProxyResolverDefaultProxyPropertyInfo), '("ignore-hosts", SimpleProxyResolverIgnoreHostsPropertyInfo)] -- VVV Prop "blocking" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSocketBlocking :: (MonadIO m, SocketK o) => o -> m Bool getSocketBlocking obj = liftIO $ getObjectPropertyBool obj "blocking" setSocketBlocking :: (MonadIO m, SocketK o) => o -> Bool -> m () setSocketBlocking obj val = liftIO $ setObjectPropertyBool obj "blocking" val constructSocketBlocking :: Bool -> IO ([Char], GValue) constructSocketBlocking val = constructObjectPropertyBool "blocking" val data SocketBlockingPropertyInfo instance AttrInfo SocketBlockingPropertyInfo where type AttrAllowedOps SocketBlockingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketBlockingPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketBlockingPropertyInfo = SocketK type AttrGetType SocketBlockingPropertyInfo = Bool type AttrLabel SocketBlockingPropertyInfo = "Socket::blocking" attrGet _ = getSocketBlocking attrSet _ = setSocketBlocking attrConstruct _ = constructSocketBlocking -- VVV Prop "broadcast" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSocketBroadcast :: (MonadIO m, SocketK o) => o -> m Bool getSocketBroadcast obj = liftIO $ getObjectPropertyBool obj "broadcast" setSocketBroadcast :: (MonadIO m, SocketK o) => o -> Bool -> m () setSocketBroadcast obj val = liftIO $ setObjectPropertyBool obj "broadcast" val constructSocketBroadcast :: Bool -> IO ([Char], GValue) constructSocketBroadcast val = constructObjectPropertyBool "broadcast" val data SocketBroadcastPropertyInfo instance AttrInfo SocketBroadcastPropertyInfo where type AttrAllowedOps SocketBroadcastPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketBroadcastPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketBroadcastPropertyInfo = SocketK type AttrGetType SocketBroadcastPropertyInfo = Bool type AttrLabel SocketBroadcastPropertyInfo = "Socket::broadcast" attrGet _ = getSocketBroadcast attrSet _ = setSocketBroadcast attrConstruct _ = constructSocketBroadcast -- VVV Prop "family" -- Type: TInterface "Gio" "SocketFamily" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketFamily :: (MonadIO m, SocketK o) => o -> m SocketFamily getSocketFamily obj = liftIO $ getObjectPropertyEnum obj "family" constructSocketFamily :: SocketFamily -> IO ([Char], GValue) constructSocketFamily val = constructObjectPropertyEnum "family" val data SocketFamilyPropertyInfo instance AttrInfo SocketFamilyPropertyInfo where type AttrAllowedOps SocketFamilyPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketFamilyPropertyInfo = (~) SocketFamily type AttrBaseTypeConstraint SocketFamilyPropertyInfo = SocketK type AttrGetType SocketFamilyPropertyInfo = SocketFamily type AttrLabel SocketFamilyPropertyInfo = "Socket::family" attrGet _ = getSocketFamily attrSet _ = undefined attrConstruct _ = constructSocketFamily -- VVV Prop "fd" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketFd :: (MonadIO m, SocketK o) => o -> m Int32 getSocketFd obj = liftIO $ getObjectPropertyCInt obj "fd" constructSocketFd :: Int32 -> IO ([Char], GValue) constructSocketFd val = constructObjectPropertyCInt "fd" val data SocketFdPropertyInfo instance AttrInfo SocketFdPropertyInfo where type AttrAllowedOps SocketFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketFdPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SocketFdPropertyInfo = SocketK type AttrGetType SocketFdPropertyInfo = Int32 type AttrLabel SocketFdPropertyInfo = "Socket::fd" attrGet _ = getSocketFd attrSet _ = undefined attrConstruct _ = constructSocketFd -- VVV Prop "keepalive" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSocketKeepalive :: (MonadIO m, SocketK o) => o -> m Bool getSocketKeepalive obj = liftIO $ getObjectPropertyBool obj "keepalive" setSocketKeepalive :: (MonadIO m, SocketK o) => o -> Bool -> m () setSocketKeepalive obj val = liftIO $ setObjectPropertyBool obj "keepalive" val constructSocketKeepalive :: Bool -> IO ([Char], GValue) constructSocketKeepalive val = constructObjectPropertyBool "keepalive" val data SocketKeepalivePropertyInfo instance AttrInfo SocketKeepalivePropertyInfo where type AttrAllowedOps SocketKeepalivePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketKeepalivePropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketKeepalivePropertyInfo = SocketK type AttrGetType SocketKeepalivePropertyInfo = Bool type AttrLabel SocketKeepalivePropertyInfo = "Socket::keepalive" attrGet _ = getSocketKeepalive attrSet _ = setSocketKeepalive attrConstruct _ = constructSocketKeepalive -- VVV Prop "listen-backlog" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable] getSocketListenBacklog :: (MonadIO m, SocketK o) => o -> m Int32 getSocketListenBacklog obj = liftIO $ getObjectPropertyCInt obj "listen-backlog" setSocketListenBacklog :: (MonadIO m, SocketK o) => o -> Int32 -> m () setSocketListenBacklog obj val = liftIO $ setObjectPropertyCInt obj "listen-backlog" val constructSocketListenBacklog :: Int32 -> IO ([Char], GValue) constructSocketListenBacklog val = constructObjectPropertyCInt "listen-backlog" val data SocketListenBacklogPropertyInfo instance AttrInfo SocketListenBacklogPropertyInfo where type AttrAllowedOps SocketListenBacklogPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketListenBacklogPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SocketListenBacklogPropertyInfo = SocketK type AttrGetType SocketListenBacklogPropertyInfo = Int32 type AttrLabel SocketListenBacklogPropertyInfo = "Socket::listen-backlog" attrGet _ = getSocketListenBacklog attrSet _ = setSocketListenBacklog attrConstruct _ = constructSocketListenBacklog -- VVV Prop "local-address" -- Type: TInterface "Gio" "SocketAddress" -- Flags: [PropertyReadable] getSocketLocalAddress :: (MonadIO m, SocketK o) => o -> m SocketAddress getSocketLocalAddress obj = liftIO $ getObjectPropertyObject obj "local-address" SocketAddress data SocketLocalAddressPropertyInfo instance AttrInfo SocketLocalAddressPropertyInfo where type AttrAllowedOps SocketLocalAddressPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketLocalAddressPropertyInfo = (~) () type AttrBaseTypeConstraint SocketLocalAddressPropertyInfo = SocketK type AttrGetType SocketLocalAddressPropertyInfo = SocketAddress type AttrLabel SocketLocalAddressPropertyInfo = "Socket::local-address" attrGet _ = getSocketLocalAddress attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "multicast-loopback" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getSocketMulticastLoopback :: (MonadIO m, SocketK o) => o -> m Bool getSocketMulticastLoopback obj = liftIO $ getObjectPropertyBool obj "multicast-loopback" setSocketMulticastLoopback :: (MonadIO m, SocketK o) => o -> Bool -> m () setSocketMulticastLoopback obj val = liftIO $ setObjectPropertyBool obj "multicast-loopback" val constructSocketMulticastLoopback :: Bool -> IO ([Char], GValue) constructSocketMulticastLoopback val = constructObjectPropertyBool "multicast-loopback" val data SocketMulticastLoopbackPropertyInfo instance AttrInfo SocketMulticastLoopbackPropertyInfo where type AttrAllowedOps SocketMulticastLoopbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketMulticastLoopbackPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketMulticastLoopbackPropertyInfo = SocketK type AttrGetType SocketMulticastLoopbackPropertyInfo = Bool type AttrLabel SocketMulticastLoopbackPropertyInfo = "Socket::multicast-loopback" attrGet _ = getSocketMulticastLoopback attrSet _ = setSocketMulticastLoopback attrConstruct _ = constructSocketMulticastLoopback -- VVV Prop "multicast-ttl" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSocketMulticastTtl :: (MonadIO m, SocketK o) => o -> m Word32 getSocketMulticastTtl obj = liftIO $ getObjectPropertyCUInt obj "multicast-ttl" setSocketMulticastTtl :: (MonadIO m, SocketK o) => o -> Word32 -> m () setSocketMulticastTtl obj val = liftIO $ setObjectPropertyCUInt obj "multicast-ttl" val constructSocketMulticastTtl :: Word32 -> IO ([Char], GValue) constructSocketMulticastTtl val = constructObjectPropertyCUInt "multicast-ttl" val data SocketMulticastTtlPropertyInfo instance AttrInfo SocketMulticastTtlPropertyInfo where type AttrAllowedOps SocketMulticastTtlPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketMulticastTtlPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SocketMulticastTtlPropertyInfo = SocketK type AttrGetType SocketMulticastTtlPropertyInfo = Word32 type AttrLabel SocketMulticastTtlPropertyInfo = "Socket::multicast-ttl" attrGet _ = getSocketMulticastTtl attrSet _ = setSocketMulticastTtl attrConstruct _ = constructSocketMulticastTtl -- VVV Prop "protocol" -- Type: TInterface "Gio" "SocketProtocol" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketProtocol :: (MonadIO m, SocketK o) => o -> m SocketProtocol getSocketProtocol obj = liftIO $ getObjectPropertyEnum obj "protocol" constructSocketProtocol :: SocketProtocol -> IO ([Char], GValue) constructSocketProtocol val = constructObjectPropertyEnum "protocol" val data SocketProtocolPropertyInfo instance AttrInfo SocketProtocolPropertyInfo where type AttrAllowedOps SocketProtocolPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketProtocolPropertyInfo = (~) SocketProtocol type AttrBaseTypeConstraint SocketProtocolPropertyInfo = SocketK type AttrGetType SocketProtocolPropertyInfo = SocketProtocol type AttrLabel SocketProtocolPropertyInfo = "Socket::protocol" attrGet _ = getSocketProtocol attrSet _ = undefined attrConstruct _ = constructSocketProtocol -- VVV Prop "remote-address" -- Type: TInterface "Gio" "SocketAddress" -- Flags: [PropertyReadable] getSocketRemoteAddress :: (MonadIO m, SocketK o) => o -> m SocketAddress getSocketRemoteAddress obj = liftIO $ getObjectPropertyObject obj "remote-address" SocketAddress data SocketRemoteAddressPropertyInfo instance AttrInfo SocketRemoteAddressPropertyInfo where type AttrAllowedOps SocketRemoteAddressPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketRemoteAddressPropertyInfo = (~) () type AttrBaseTypeConstraint SocketRemoteAddressPropertyInfo = SocketK type AttrGetType SocketRemoteAddressPropertyInfo = SocketAddress type AttrLabel SocketRemoteAddressPropertyInfo = "Socket::remote-address" attrGet _ = getSocketRemoteAddress attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSocketTimeout :: (MonadIO m, SocketK o) => o -> m Word32 getSocketTimeout obj = liftIO $ getObjectPropertyCUInt obj "timeout" setSocketTimeout :: (MonadIO m, SocketK o) => o -> Word32 -> m () setSocketTimeout obj val = liftIO $ setObjectPropertyCUInt obj "timeout" val constructSocketTimeout :: Word32 -> IO ([Char], GValue) constructSocketTimeout val = constructObjectPropertyCUInt "timeout" val data SocketTimeoutPropertyInfo instance AttrInfo SocketTimeoutPropertyInfo where type AttrAllowedOps SocketTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SocketTimeoutPropertyInfo = SocketK type AttrGetType SocketTimeoutPropertyInfo = Word32 type AttrLabel SocketTimeoutPropertyInfo = "Socket::timeout" attrGet _ = getSocketTimeout attrSet _ = setSocketTimeout attrConstruct _ = constructSocketTimeout -- VVV Prop "ttl" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable] getSocketTtl :: (MonadIO m, SocketK o) => o -> m Word32 getSocketTtl obj = liftIO $ getObjectPropertyCUInt obj "ttl" setSocketTtl :: (MonadIO m, SocketK o) => o -> Word32 -> m () setSocketTtl obj val = liftIO $ setObjectPropertyCUInt obj "ttl" val constructSocketTtl :: Word32 -> IO ([Char], GValue) constructSocketTtl val = constructObjectPropertyCUInt "ttl" val data SocketTtlPropertyInfo instance AttrInfo SocketTtlPropertyInfo where type AttrAllowedOps SocketTtlPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketTtlPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SocketTtlPropertyInfo = SocketK type AttrGetType SocketTtlPropertyInfo = Word32 type AttrLabel SocketTtlPropertyInfo = "Socket::ttl" attrGet _ = getSocketTtl attrSet _ = setSocketTtl attrConstruct _ = constructSocketTtl -- VVV Prop "type" -- Type: TInterface "Gio" "SocketType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketType :: (MonadIO m, SocketK o) => o -> m SocketType getSocketType obj = liftIO $ getObjectPropertyEnum obj "type" constructSocketType :: SocketType -> IO ([Char], GValue) constructSocketType val = constructObjectPropertyEnum "type" val data SocketTypePropertyInfo instance AttrInfo SocketTypePropertyInfo where type AttrAllowedOps SocketTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketTypePropertyInfo = (~) SocketType type AttrBaseTypeConstraint SocketTypePropertyInfo = SocketK type AttrGetType SocketTypePropertyInfo = SocketType type AttrLabel SocketTypePropertyInfo = "Socket::type" attrGet _ = getSocketType attrSet _ = undefined attrConstruct _ = constructSocketType type instance AttributeList Socket = '[ '("blocking", SocketBlockingPropertyInfo), '("broadcast", SocketBroadcastPropertyInfo), '("family", SocketFamilyPropertyInfo), '("fd", SocketFdPropertyInfo), '("keepalive", SocketKeepalivePropertyInfo), '("listen-backlog", SocketListenBacklogPropertyInfo), '("local-address", SocketLocalAddressPropertyInfo), '("multicast-loopback", SocketMulticastLoopbackPropertyInfo), '("multicast-ttl", SocketMulticastTtlPropertyInfo), '("protocol", SocketProtocolPropertyInfo), '("remote-address", SocketRemoteAddressPropertyInfo), '("timeout", SocketTimeoutPropertyInfo), '("ttl", SocketTtlPropertyInfo), '("type", SocketTypePropertyInfo)] -- VVV Prop "family" -- Type: TInterface "Gio" "SocketFamily" -- Flags: [PropertyReadable] getSocketAddressFamily :: (MonadIO m, SocketAddressK o) => o -> m SocketFamily getSocketAddressFamily obj = liftIO $ getObjectPropertyEnum obj "family" data SocketAddressFamilyPropertyInfo instance AttrInfo SocketAddressFamilyPropertyInfo where type AttrAllowedOps SocketAddressFamilyPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint SocketAddressFamilyPropertyInfo = (~) () type AttrBaseTypeConstraint SocketAddressFamilyPropertyInfo = SocketAddressK type AttrGetType SocketAddressFamilyPropertyInfo = SocketFamily type AttrLabel SocketAddressFamilyPropertyInfo = "SocketAddress::family" attrGet _ = getSocketAddressFamily attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList SocketAddress = '[ '("family", SocketAddressFamilyPropertyInfo)] type instance AttributeList SocketAddressEnumerator = '[ ] -- VVV Prop "enable-proxy" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientEnableProxy :: (MonadIO m, SocketClientK o) => o -> m Bool getSocketClientEnableProxy obj = liftIO $ getObjectPropertyBool obj "enable-proxy" setSocketClientEnableProxy :: (MonadIO m, SocketClientK o) => o -> Bool -> m () setSocketClientEnableProxy obj val = liftIO $ setObjectPropertyBool obj "enable-proxy" val constructSocketClientEnableProxy :: Bool -> IO ([Char], GValue) constructSocketClientEnableProxy val = constructObjectPropertyBool "enable-proxy" val data SocketClientEnableProxyPropertyInfo instance AttrInfo SocketClientEnableProxyPropertyInfo where type AttrAllowedOps SocketClientEnableProxyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientEnableProxyPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketClientEnableProxyPropertyInfo = SocketClientK type AttrGetType SocketClientEnableProxyPropertyInfo = Bool type AttrLabel SocketClientEnableProxyPropertyInfo = "SocketClient::enable-proxy" attrGet _ = getSocketClientEnableProxy attrSet _ = setSocketClientEnableProxy attrConstruct _ = constructSocketClientEnableProxy -- VVV Prop "family" -- Type: TInterface "Gio" "SocketFamily" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientFamily :: (MonadIO m, SocketClientK o) => o -> m SocketFamily getSocketClientFamily obj = liftIO $ getObjectPropertyEnum obj "family" setSocketClientFamily :: (MonadIO m, SocketClientK o) => o -> SocketFamily -> m () setSocketClientFamily obj val = liftIO $ setObjectPropertyEnum obj "family" val constructSocketClientFamily :: SocketFamily -> IO ([Char], GValue) constructSocketClientFamily val = constructObjectPropertyEnum "family" val data SocketClientFamilyPropertyInfo instance AttrInfo SocketClientFamilyPropertyInfo where type AttrAllowedOps SocketClientFamilyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientFamilyPropertyInfo = (~) SocketFamily type AttrBaseTypeConstraint SocketClientFamilyPropertyInfo = SocketClientK type AttrGetType SocketClientFamilyPropertyInfo = SocketFamily type AttrLabel SocketClientFamilyPropertyInfo = "SocketClient::family" attrGet _ = getSocketClientFamily attrSet _ = setSocketClientFamily attrConstruct _ = constructSocketClientFamily -- VVV Prop "local-address" -- Type: TInterface "Gio" "SocketAddress" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientLocalAddress :: (MonadIO m, SocketClientK o) => o -> m SocketAddress getSocketClientLocalAddress obj = liftIO $ getObjectPropertyObject obj "local-address" SocketAddress setSocketClientLocalAddress :: (MonadIO m, SocketClientK o, SocketAddressK a) => o -> a -> m () setSocketClientLocalAddress obj val = liftIO $ setObjectPropertyObject obj "local-address" val constructSocketClientLocalAddress :: (SocketAddressK a) => a -> IO ([Char], GValue) constructSocketClientLocalAddress val = constructObjectPropertyObject "local-address" val data SocketClientLocalAddressPropertyInfo instance AttrInfo SocketClientLocalAddressPropertyInfo where type AttrAllowedOps SocketClientLocalAddressPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientLocalAddressPropertyInfo = SocketAddressK type AttrBaseTypeConstraint SocketClientLocalAddressPropertyInfo = SocketClientK type AttrGetType SocketClientLocalAddressPropertyInfo = SocketAddress type AttrLabel SocketClientLocalAddressPropertyInfo = "SocketClient::local-address" attrGet _ = getSocketClientLocalAddress attrSet _ = setSocketClientLocalAddress attrConstruct _ = constructSocketClientLocalAddress -- VVV Prop "protocol" -- Type: TInterface "Gio" "SocketProtocol" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientProtocol :: (MonadIO m, SocketClientK o) => o -> m SocketProtocol getSocketClientProtocol obj = liftIO $ getObjectPropertyEnum obj "protocol" setSocketClientProtocol :: (MonadIO m, SocketClientK o) => o -> SocketProtocol -> m () setSocketClientProtocol obj val = liftIO $ setObjectPropertyEnum obj "protocol" val constructSocketClientProtocol :: SocketProtocol -> IO ([Char], GValue) constructSocketClientProtocol val = constructObjectPropertyEnum "protocol" val data SocketClientProtocolPropertyInfo instance AttrInfo SocketClientProtocolPropertyInfo where type AttrAllowedOps SocketClientProtocolPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientProtocolPropertyInfo = (~) SocketProtocol type AttrBaseTypeConstraint SocketClientProtocolPropertyInfo = SocketClientK type AttrGetType SocketClientProtocolPropertyInfo = SocketProtocol type AttrLabel SocketClientProtocolPropertyInfo = "SocketClient::protocol" attrGet _ = getSocketClientProtocol attrSet _ = setSocketClientProtocol attrConstruct _ = constructSocketClientProtocol -- VVV Prop "proxy-resolver" -- Type: TInterface "Gio" "ProxyResolver" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientProxyResolver :: (MonadIO m, SocketClientK o) => o -> m ProxyResolver getSocketClientProxyResolver obj = liftIO $ getObjectPropertyObject obj "proxy-resolver" ProxyResolver setSocketClientProxyResolver :: (MonadIO m, SocketClientK o, ProxyResolverK a) => o -> a -> m () setSocketClientProxyResolver obj val = liftIO $ setObjectPropertyObject obj "proxy-resolver" val constructSocketClientProxyResolver :: (ProxyResolverK a) => a -> IO ([Char], GValue) constructSocketClientProxyResolver val = constructObjectPropertyObject "proxy-resolver" val data SocketClientProxyResolverPropertyInfo instance AttrInfo SocketClientProxyResolverPropertyInfo where type AttrAllowedOps SocketClientProxyResolverPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientProxyResolverPropertyInfo = ProxyResolverK type AttrBaseTypeConstraint SocketClientProxyResolverPropertyInfo = SocketClientK type AttrGetType SocketClientProxyResolverPropertyInfo = ProxyResolver type AttrLabel SocketClientProxyResolverPropertyInfo = "SocketClient::proxy-resolver" attrGet _ = getSocketClientProxyResolver attrSet _ = setSocketClientProxyResolver attrConstruct _ = constructSocketClientProxyResolver -- VVV Prop "timeout" -- Type: TBasicType TUInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientTimeout :: (MonadIO m, SocketClientK o) => o -> m Word32 getSocketClientTimeout obj = liftIO $ getObjectPropertyCUInt obj "timeout" setSocketClientTimeout :: (MonadIO m, SocketClientK o) => o -> Word32 -> m () setSocketClientTimeout obj val = liftIO $ setObjectPropertyCUInt obj "timeout" val constructSocketClientTimeout :: Word32 -> IO ([Char], GValue) constructSocketClientTimeout val = constructObjectPropertyCUInt "timeout" val data SocketClientTimeoutPropertyInfo instance AttrInfo SocketClientTimeoutPropertyInfo where type AttrAllowedOps SocketClientTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientTimeoutPropertyInfo = (~) Word32 type AttrBaseTypeConstraint SocketClientTimeoutPropertyInfo = SocketClientK type AttrGetType SocketClientTimeoutPropertyInfo = Word32 type AttrLabel SocketClientTimeoutPropertyInfo = "SocketClient::timeout" attrGet _ = getSocketClientTimeout attrSet _ = setSocketClientTimeout attrConstruct _ = constructSocketClientTimeout -- VVV Prop "tls" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientTls :: (MonadIO m, SocketClientK o) => o -> m Bool getSocketClientTls obj = liftIO $ getObjectPropertyBool obj "tls" setSocketClientTls :: (MonadIO m, SocketClientK o) => o -> Bool -> m () setSocketClientTls obj val = liftIO $ setObjectPropertyBool obj "tls" val constructSocketClientTls :: Bool -> IO ([Char], GValue) constructSocketClientTls val = constructObjectPropertyBool "tls" val data SocketClientTlsPropertyInfo instance AttrInfo SocketClientTlsPropertyInfo where type AttrAllowedOps SocketClientTlsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientTlsPropertyInfo = (~) Bool type AttrBaseTypeConstraint SocketClientTlsPropertyInfo = SocketClientK type AttrGetType SocketClientTlsPropertyInfo = Bool type AttrLabel SocketClientTlsPropertyInfo = "SocketClient::tls" attrGet _ = getSocketClientTls attrSet _ = setSocketClientTls attrConstruct _ = constructSocketClientTls -- VVV Prop "tls-validation-flags" -- Type: TInterface "Gio" "TlsCertificateFlags" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientTlsValidationFlags :: (MonadIO m, SocketClientK o) => o -> m [TlsCertificateFlags] getSocketClientTlsValidationFlags obj = liftIO $ getObjectPropertyFlags obj "tls-validation-flags" setSocketClientTlsValidationFlags :: (MonadIO m, SocketClientK o) => o -> [TlsCertificateFlags] -> m () setSocketClientTlsValidationFlags obj val = liftIO $ setObjectPropertyFlags obj "tls-validation-flags" val constructSocketClientTlsValidationFlags :: [TlsCertificateFlags] -> IO ([Char], GValue) constructSocketClientTlsValidationFlags val = constructObjectPropertyFlags "tls-validation-flags" val data SocketClientTlsValidationFlagsPropertyInfo instance AttrInfo SocketClientTlsValidationFlagsPropertyInfo where type AttrAllowedOps SocketClientTlsValidationFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientTlsValidationFlagsPropertyInfo = (~) [TlsCertificateFlags] type AttrBaseTypeConstraint SocketClientTlsValidationFlagsPropertyInfo = SocketClientK type AttrGetType SocketClientTlsValidationFlagsPropertyInfo = [TlsCertificateFlags] type AttrLabel SocketClientTlsValidationFlagsPropertyInfo = "SocketClient::tls-validation-flags" attrGet _ = getSocketClientTlsValidationFlags attrSet _ = setSocketClientTlsValidationFlags attrConstruct _ = constructSocketClientTlsValidationFlags -- VVV Prop "type" -- Type: TInterface "Gio" "SocketType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketClientType :: (MonadIO m, SocketClientK o) => o -> m SocketType getSocketClientType obj = liftIO $ getObjectPropertyEnum obj "type" setSocketClientType :: (MonadIO m, SocketClientK o) => o -> SocketType -> m () setSocketClientType obj val = liftIO $ setObjectPropertyEnum obj "type" val constructSocketClientType :: SocketType -> IO ([Char], GValue) constructSocketClientType val = constructObjectPropertyEnum "type" val data SocketClientTypePropertyInfo instance AttrInfo SocketClientTypePropertyInfo where type AttrAllowedOps SocketClientTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketClientTypePropertyInfo = (~) SocketType type AttrBaseTypeConstraint SocketClientTypePropertyInfo = SocketClientK type AttrGetType SocketClientTypePropertyInfo = SocketType type AttrLabel SocketClientTypePropertyInfo = "SocketClient::type" attrGet _ = getSocketClientType attrSet _ = setSocketClientType attrConstruct _ = constructSocketClientType type instance AttributeList SocketClient = '[ '("enable-proxy", SocketClientEnableProxyPropertyInfo), '("family", SocketClientFamilyPropertyInfo), '("local-address", SocketClientLocalAddressPropertyInfo), '("protocol", SocketClientProtocolPropertyInfo), '("proxy-resolver", SocketClientProxyResolverPropertyInfo), '("timeout", SocketClientTimeoutPropertyInfo), '("tls", SocketClientTlsPropertyInfo), '("tls-validation-flags", SocketClientTlsValidationFlagsPropertyInfo), '("type", SocketClientTypePropertyInfo)] type instance AttributeList SocketConnectable = '[ ] -- VVV Prop "socket" -- Type: TInterface "Gio" "Socket" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getSocketConnectionSocket :: (MonadIO m, SocketConnectionK o) => o -> m Socket getSocketConnectionSocket obj = liftIO $ getObjectPropertyObject obj "socket" Socket constructSocketConnectionSocket :: (SocketK a) => a -> IO ([Char], GValue) constructSocketConnectionSocket val = constructObjectPropertyObject "socket" val data SocketConnectionSocketPropertyInfo instance AttrInfo SocketConnectionSocketPropertyInfo where type AttrAllowedOps SocketConnectionSocketPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketConnectionSocketPropertyInfo = SocketK type AttrBaseTypeConstraint SocketConnectionSocketPropertyInfo = SocketConnectionK type AttrGetType SocketConnectionSocketPropertyInfo = Socket type AttrLabel SocketConnectionSocketPropertyInfo = "SocketConnection::socket" attrGet _ = getSocketConnectionSocket attrSet _ = undefined attrConstruct _ = constructSocketConnectionSocket type instance AttributeList SocketConnection = '[ '("closed", IOStreamClosedPropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("socket", SocketConnectionSocketPropertyInfo)] type instance AttributeList SocketControlMessage = '[ ] -- VVV Prop "listen-backlog" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getSocketListenerListenBacklog :: (MonadIO m, SocketListenerK o) => o -> m Int32 getSocketListenerListenBacklog obj = liftIO $ getObjectPropertyCInt obj "listen-backlog" setSocketListenerListenBacklog :: (MonadIO m, SocketListenerK o) => o -> Int32 -> m () setSocketListenerListenBacklog obj val = liftIO $ setObjectPropertyCInt obj "listen-backlog" val constructSocketListenerListenBacklog :: Int32 -> IO ([Char], GValue) constructSocketListenerListenBacklog val = constructObjectPropertyCInt "listen-backlog" val data SocketListenerListenBacklogPropertyInfo instance AttrInfo SocketListenerListenBacklogPropertyInfo where type AttrAllowedOps SocketListenerListenBacklogPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint SocketListenerListenBacklogPropertyInfo = (~) Int32 type AttrBaseTypeConstraint SocketListenerListenBacklogPropertyInfo = SocketListenerK type AttrGetType SocketListenerListenBacklogPropertyInfo = Int32 type AttrLabel SocketListenerListenBacklogPropertyInfo = "SocketListener::listen-backlog" attrGet _ = getSocketListenerListenBacklog attrSet _ = setSocketListenerListenBacklog attrConstruct _ = constructSocketListenerListenBacklog type instance AttributeList SocketListener = '[ '("listen-backlog", SocketListenerListenBacklogPropertyInfo)] type instance AttributeList SocketService = '[ '("listen-backlog", SocketListenerListenBacklogPropertyInfo)] -- VVV Prop "argv" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyWritable,PropertyConstructOnly] constructSubprocessArgv :: [T.Text] -> IO ([Char], GValue) constructSubprocessArgv val = constructObjectPropertyStringArray "argv" val data SubprocessArgvPropertyInfo instance AttrInfo SubprocessArgvPropertyInfo where type AttrAllowedOps SubprocessArgvPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint SubprocessArgvPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint SubprocessArgvPropertyInfo = SubprocessK type AttrGetType SubprocessArgvPropertyInfo = () type AttrLabel SubprocessArgvPropertyInfo = "Subprocess::argv" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructSubprocessArgv -- VVV Prop "flags" -- Type: TInterface "Gio" "SubprocessFlags" -- Flags: [PropertyWritable,PropertyConstructOnly] constructSubprocessFlags :: [SubprocessFlags] -> IO ([Char], GValue) constructSubprocessFlags val = constructObjectPropertyFlags "flags" val data SubprocessFlagsPropertyInfo instance AttrInfo SubprocessFlagsPropertyInfo where type AttrAllowedOps SubprocessFlagsPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint SubprocessFlagsPropertyInfo = (~) [SubprocessFlags] type AttrBaseTypeConstraint SubprocessFlagsPropertyInfo = SubprocessK type AttrGetType SubprocessFlagsPropertyInfo = () type AttrLabel SubprocessFlagsPropertyInfo = "Subprocess::flags" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructSubprocessFlags type instance AttributeList Subprocess = '[ '("argv", SubprocessArgvPropertyInfo), '("flags", SubprocessFlagsPropertyInfo)] -- VVV Prop "flags" -- Type: TInterface "Gio" "SubprocessFlags" -- Flags: [PropertyWritable,PropertyConstructOnly] constructSubprocessLauncherFlags :: [SubprocessFlags] -> IO ([Char], GValue) constructSubprocessLauncherFlags val = constructObjectPropertyFlags "flags" val data SubprocessLauncherFlagsPropertyInfo instance AttrInfo SubprocessLauncherFlagsPropertyInfo where type AttrAllowedOps SubprocessLauncherFlagsPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint SubprocessLauncherFlagsPropertyInfo = (~) [SubprocessFlags] type AttrBaseTypeConstraint SubprocessLauncherFlagsPropertyInfo = SubprocessLauncherK type AttrGetType SubprocessLauncherFlagsPropertyInfo = () type AttrLabel SubprocessLauncherFlagsPropertyInfo = "SubprocessLauncher::flags" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructSubprocessLauncherFlags type instance AttributeList SubprocessLauncher = '[ '("flags", SubprocessLauncherFlagsPropertyInfo)] -- VVV Prop "completed" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable] getTaskCompleted :: (MonadIO m, TaskK o) => o -> m Bool getTaskCompleted obj = liftIO $ getObjectPropertyBool obj "completed" data TaskCompletedPropertyInfo instance AttrInfo TaskCompletedPropertyInfo where type AttrAllowedOps TaskCompletedPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TaskCompletedPropertyInfo = (~) () type AttrBaseTypeConstraint TaskCompletedPropertyInfo = TaskK type AttrGetType TaskCompletedPropertyInfo = Bool type AttrLabel TaskCompletedPropertyInfo = "Task::completed" attrGet _ = getTaskCompleted attrSet _ = undefined attrConstruct _ = undefined type instance AttributeList Task = '[ '("completed", TaskCompletedPropertyInfo)] -- VVV Prop "graceful-disconnect" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getTcpConnectionGracefulDisconnect :: (MonadIO m, TcpConnectionK o) => o -> m Bool getTcpConnectionGracefulDisconnect obj = liftIO $ getObjectPropertyBool obj "graceful-disconnect" setTcpConnectionGracefulDisconnect :: (MonadIO m, TcpConnectionK o) => o -> Bool -> m () setTcpConnectionGracefulDisconnect obj val = liftIO $ setObjectPropertyBool obj "graceful-disconnect" val constructTcpConnectionGracefulDisconnect :: Bool -> IO ([Char], GValue) constructTcpConnectionGracefulDisconnect val = constructObjectPropertyBool "graceful-disconnect" val data TcpConnectionGracefulDisconnectPropertyInfo instance AttrInfo TcpConnectionGracefulDisconnectPropertyInfo where type AttrAllowedOps TcpConnectionGracefulDisconnectPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TcpConnectionGracefulDisconnectPropertyInfo = (~) Bool type AttrBaseTypeConstraint TcpConnectionGracefulDisconnectPropertyInfo = TcpConnectionK type AttrGetType TcpConnectionGracefulDisconnectPropertyInfo = Bool type AttrLabel TcpConnectionGracefulDisconnectPropertyInfo = "TcpConnection::graceful-disconnect" attrGet _ = getTcpConnectionGracefulDisconnect attrSet _ = setTcpConnectionGracefulDisconnect attrConstruct _ = constructTcpConnectionGracefulDisconnect type instance AttributeList TcpConnection = '[ '("closed", IOStreamClosedPropertyInfo), '("graceful-disconnect", TcpConnectionGracefulDisconnectPropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("socket", SocketConnectionSocketPropertyInfo)] -- VVV Prop "base-io-stream" -- Type: TInterface "Gio" "IOStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTcpWrapperConnectionBaseIoStream :: (MonadIO m, TcpWrapperConnectionK o) => o -> m IOStream getTcpWrapperConnectionBaseIoStream obj = liftIO $ getObjectPropertyObject obj "base-io-stream" IOStream constructTcpWrapperConnectionBaseIoStream :: (IOStreamK a) => a -> IO ([Char], GValue) constructTcpWrapperConnectionBaseIoStream val = constructObjectPropertyObject "base-io-stream" val data TcpWrapperConnectionBaseIoStreamPropertyInfo instance AttrInfo TcpWrapperConnectionBaseIoStreamPropertyInfo where type AttrAllowedOps TcpWrapperConnectionBaseIoStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TcpWrapperConnectionBaseIoStreamPropertyInfo = IOStreamK type AttrBaseTypeConstraint TcpWrapperConnectionBaseIoStreamPropertyInfo = TcpWrapperConnectionK type AttrGetType TcpWrapperConnectionBaseIoStreamPropertyInfo = IOStream type AttrLabel TcpWrapperConnectionBaseIoStreamPropertyInfo = "TcpWrapperConnection::base-io-stream" attrGet _ = getTcpWrapperConnectionBaseIoStream attrSet _ = undefined attrConstruct _ = constructTcpWrapperConnectionBaseIoStream type instance AttributeList TcpWrapperConnection = '[ '("base-io-stream", TcpWrapperConnectionBaseIoStreamPropertyInfo), '("closed", IOStreamClosedPropertyInfo), '("graceful-disconnect", TcpConnectionGracefulDisconnectPropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("socket", SocketConnectionSocketPropertyInfo)] -- VVV Prop "flags" -- Type: TInterface "Gio" "TestDBusFlags" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTestDBusFlags :: (MonadIO m, TestDBusK o) => o -> m [TestDBusFlags] getTestDBusFlags obj = liftIO $ getObjectPropertyFlags obj "flags" constructTestDBusFlags :: [TestDBusFlags] -> IO ([Char], GValue) constructTestDBusFlags val = constructObjectPropertyFlags "flags" val data TestDBusFlagsPropertyInfo instance AttrInfo TestDBusFlagsPropertyInfo where type AttrAllowedOps TestDBusFlagsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TestDBusFlagsPropertyInfo = (~) [TestDBusFlags] type AttrBaseTypeConstraint TestDBusFlagsPropertyInfo = TestDBusK type AttrGetType TestDBusFlagsPropertyInfo = [TestDBusFlags] type AttrLabel TestDBusFlagsPropertyInfo = "TestDBus::flags" attrGet _ = getTestDBusFlags attrSet _ = undefined attrConstruct _ = constructTestDBusFlags type instance AttributeList TestDBus = '[ '("flags", TestDBusFlagsPropertyInfo)] -- VVV Prop "name" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable,PropertyConstructOnly] constructThemedIconName :: T.Text -> IO ([Char], GValue) constructThemedIconName val = constructObjectPropertyString "name" val data ThemedIconNamePropertyInfo instance AttrInfo ThemedIconNamePropertyInfo where type AttrAllowedOps ThemedIconNamePropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint ThemedIconNamePropertyInfo = (~) T.Text type AttrBaseTypeConstraint ThemedIconNamePropertyInfo = ThemedIconK type AttrGetType ThemedIconNamePropertyInfo = () type AttrLabel ThemedIconNamePropertyInfo = "ThemedIcon::name" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructThemedIconName -- VVV Prop "names" -- Type: TCArray True (-1) (-1) (TBasicType TUTF8) -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getThemedIconNames :: (MonadIO m, ThemedIconK o) => o -> m [T.Text] getThemedIconNames obj = liftIO $ getObjectPropertyStringArray obj "names" constructThemedIconNames :: [T.Text] -> IO ([Char], GValue) constructThemedIconNames val = constructObjectPropertyStringArray "names" val data ThemedIconNamesPropertyInfo instance AttrInfo ThemedIconNamesPropertyInfo where type AttrAllowedOps ThemedIconNamesPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ThemedIconNamesPropertyInfo = (~) [T.Text] type AttrBaseTypeConstraint ThemedIconNamesPropertyInfo = ThemedIconK type AttrGetType ThemedIconNamesPropertyInfo = [T.Text] type AttrLabel ThemedIconNamesPropertyInfo = "ThemedIcon::names" attrGet _ = getThemedIconNames attrSet _ = undefined attrConstruct _ = constructThemedIconNames -- VVV Prop "use-default-fallbacks" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getThemedIconUseDefaultFallbacks :: (MonadIO m, ThemedIconK o) => o -> m Bool getThemedIconUseDefaultFallbacks obj = liftIO $ getObjectPropertyBool obj "use-default-fallbacks" constructThemedIconUseDefaultFallbacks :: Bool -> IO ([Char], GValue) constructThemedIconUseDefaultFallbacks val = constructObjectPropertyBool "use-default-fallbacks" val data ThemedIconUseDefaultFallbacksPropertyInfo instance AttrInfo ThemedIconUseDefaultFallbacksPropertyInfo where type AttrAllowedOps ThemedIconUseDefaultFallbacksPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ThemedIconUseDefaultFallbacksPropertyInfo = (~) Bool type AttrBaseTypeConstraint ThemedIconUseDefaultFallbacksPropertyInfo = ThemedIconK type AttrGetType ThemedIconUseDefaultFallbacksPropertyInfo = Bool type AttrLabel ThemedIconUseDefaultFallbacksPropertyInfo = "ThemedIcon::use-default-fallbacks" attrGet _ = getThemedIconUseDefaultFallbacks attrSet _ = undefined attrConstruct _ = constructThemedIconUseDefaultFallbacks type instance AttributeList ThemedIcon = '[ '("name", ThemedIconNamePropertyInfo), '("names", ThemedIconNamesPropertyInfo), '("use-default-fallbacks", ThemedIconUseDefaultFallbacksPropertyInfo)] -- VVV Prop "max-threads" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getThreadedSocketServiceMaxThreads :: (MonadIO m, ThreadedSocketServiceK o) => o -> m Int32 getThreadedSocketServiceMaxThreads obj = liftIO $ getObjectPropertyCInt obj "max-threads" constructThreadedSocketServiceMaxThreads :: Int32 -> IO ([Char], GValue) constructThreadedSocketServiceMaxThreads val = constructObjectPropertyCInt "max-threads" val data ThreadedSocketServiceMaxThreadsPropertyInfo instance AttrInfo ThreadedSocketServiceMaxThreadsPropertyInfo where type AttrAllowedOps ThreadedSocketServiceMaxThreadsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ThreadedSocketServiceMaxThreadsPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ThreadedSocketServiceMaxThreadsPropertyInfo = ThreadedSocketServiceK type AttrGetType ThreadedSocketServiceMaxThreadsPropertyInfo = Int32 type AttrLabel ThreadedSocketServiceMaxThreadsPropertyInfo = "ThreadedSocketService::max-threads" attrGet _ = getThreadedSocketServiceMaxThreads attrSet _ = undefined attrConstruct _ = constructThreadedSocketServiceMaxThreads type instance AttributeList ThreadedSocketService = '[ '("listen-backlog", SocketListenerListenBacklogPropertyInfo), '("max-threads", ThreadedSocketServiceMaxThreadsPropertyInfo)] type instance AttributeList TlsBackend = '[ ] -- VVV Prop "certificate" -- Type: TByteArray -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTlsCertificateCertificate :: (MonadIO m, TlsCertificateK o) => o -> m ByteString getTlsCertificateCertificate obj = liftIO $ getObjectPropertyByteArray obj "certificate" constructTlsCertificateCertificate :: ByteString -> IO ([Char], GValue) constructTlsCertificateCertificate val = constructObjectPropertyByteArray "certificate" val data TlsCertificateCertificatePropertyInfo instance AttrInfo TlsCertificateCertificatePropertyInfo where type AttrAllowedOps TlsCertificateCertificatePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsCertificateCertificatePropertyInfo = (~) ByteString type AttrBaseTypeConstraint TlsCertificateCertificatePropertyInfo = TlsCertificateK type AttrGetType TlsCertificateCertificatePropertyInfo = ByteString type AttrLabel TlsCertificateCertificatePropertyInfo = "TlsCertificate::certificate" attrGet _ = getTlsCertificateCertificate attrSet _ = undefined attrConstruct _ = constructTlsCertificateCertificate -- VVV Prop "certificate-pem" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTlsCertificateCertificatePem :: (MonadIO m, TlsCertificateK o) => o -> m T.Text getTlsCertificateCertificatePem obj = liftIO $ getObjectPropertyString obj "certificate-pem" constructTlsCertificateCertificatePem :: T.Text -> IO ([Char], GValue) constructTlsCertificateCertificatePem val = constructObjectPropertyString "certificate-pem" val data TlsCertificateCertificatePemPropertyInfo instance AttrInfo TlsCertificateCertificatePemPropertyInfo where type AttrAllowedOps TlsCertificateCertificatePemPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsCertificateCertificatePemPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TlsCertificateCertificatePemPropertyInfo = TlsCertificateK type AttrGetType TlsCertificateCertificatePemPropertyInfo = T.Text type AttrLabel TlsCertificateCertificatePemPropertyInfo = "TlsCertificate::certificate-pem" attrGet _ = getTlsCertificateCertificatePem attrSet _ = undefined attrConstruct _ = constructTlsCertificateCertificatePem -- VVV Prop "issuer" -- Type: TInterface "Gio" "TlsCertificate" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTlsCertificateIssuer :: (MonadIO m, TlsCertificateK o) => o -> m TlsCertificate getTlsCertificateIssuer obj = liftIO $ getObjectPropertyObject obj "issuer" TlsCertificate constructTlsCertificateIssuer :: (TlsCertificateK a) => a -> IO ([Char], GValue) constructTlsCertificateIssuer val = constructObjectPropertyObject "issuer" val data TlsCertificateIssuerPropertyInfo instance AttrInfo TlsCertificateIssuerPropertyInfo where type AttrAllowedOps TlsCertificateIssuerPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsCertificateIssuerPropertyInfo = TlsCertificateK type AttrBaseTypeConstraint TlsCertificateIssuerPropertyInfo = TlsCertificateK type AttrGetType TlsCertificateIssuerPropertyInfo = TlsCertificate type AttrLabel TlsCertificateIssuerPropertyInfo = "TlsCertificate::issuer" attrGet _ = getTlsCertificateIssuer attrSet _ = undefined attrConstruct _ = constructTlsCertificateIssuer -- VVV Prop "private-key" -- Type: TByteArray -- Flags: [PropertyWritable,PropertyConstructOnly] constructTlsCertificatePrivateKey :: ByteString -> IO ([Char], GValue) constructTlsCertificatePrivateKey val = constructObjectPropertyByteArray "private-key" val data TlsCertificatePrivateKeyPropertyInfo instance AttrInfo TlsCertificatePrivateKeyPropertyInfo where type AttrAllowedOps TlsCertificatePrivateKeyPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint TlsCertificatePrivateKeyPropertyInfo = (~) ByteString type AttrBaseTypeConstraint TlsCertificatePrivateKeyPropertyInfo = TlsCertificateK type AttrGetType TlsCertificatePrivateKeyPropertyInfo = () type AttrLabel TlsCertificatePrivateKeyPropertyInfo = "TlsCertificate::private-key" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructTlsCertificatePrivateKey -- VVV Prop "private-key-pem" -- Type: TBasicType TUTF8 -- Flags: [PropertyWritable,PropertyConstructOnly] constructTlsCertificatePrivateKeyPem :: T.Text -> IO ([Char], GValue) constructTlsCertificatePrivateKeyPem val = constructObjectPropertyString "private-key-pem" val data TlsCertificatePrivateKeyPemPropertyInfo instance AttrInfo TlsCertificatePrivateKeyPemPropertyInfo where type AttrAllowedOps TlsCertificatePrivateKeyPemPropertyInfo = '[ 'AttrConstruct] type AttrSetTypeConstraint TlsCertificatePrivateKeyPemPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TlsCertificatePrivateKeyPemPropertyInfo = TlsCertificateK type AttrGetType TlsCertificatePrivateKeyPemPropertyInfo = () type AttrLabel TlsCertificatePrivateKeyPemPropertyInfo = "TlsCertificate::private-key-pem" attrGet _ = undefined attrSet _ = undefined attrConstruct _ = constructTlsCertificatePrivateKeyPem type instance AttributeList TlsCertificate = '[ '("certificate", TlsCertificateCertificatePropertyInfo), '("certificate-pem", TlsCertificateCertificatePemPropertyInfo), '("issuer", TlsCertificateIssuerPropertyInfo), '("private-key", TlsCertificatePrivateKeyPropertyInfo), '("private-key-pem", TlsCertificatePrivateKeyPemPropertyInfo)] -- VVV Prop "accepted-cas" -- Type: TGList (TBasicType TVoid) -- Flags: [PropertyReadable] getTlsClientConnectionAcceptedCas :: (MonadIO m, TlsClientConnectionK o) => o -> m [Ptr ()] getTlsClientConnectionAcceptedCas obj = liftIO $ getObjectPropertyPtrGList obj "accepted-cas" data TlsClientConnectionAcceptedCasPropertyInfo instance AttrInfo TlsClientConnectionAcceptedCasPropertyInfo where type AttrAllowedOps TlsClientConnectionAcceptedCasPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TlsClientConnectionAcceptedCasPropertyInfo = (~) () type AttrBaseTypeConstraint TlsClientConnectionAcceptedCasPropertyInfo = TlsClientConnectionK type AttrGetType TlsClientConnectionAcceptedCasPropertyInfo = ([Ptr ()]) type AttrLabel TlsClientConnectionAcceptedCasPropertyInfo = "TlsClientConnection::accepted-cas" attrGet _ = getTlsClientConnectionAcceptedCas attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "server-identity" -- Type: TInterface "Gio" "SocketConnectable" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsClientConnectionServerIdentity :: (MonadIO m, TlsClientConnectionK o) => o -> m SocketConnectable getTlsClientConnectionServerIdentity obj = liftIO $ getObjectPropertyObject obj "server-identity" SocketConnectable setTlsClientConnectionServerIdentity :: (MonadIO m, TlsClientConnectionK o, SocketConnectableK a) => o -> a -> m () setTlsClientConnectionServerIdentity obj val = liftIO $ setObjectPropertyObject obj "server-identity" val constructTlsClientConnectionServerIdentity :: (SocketConnectableK a) => a -> IO ([Char], GValue) constructTlsClientConnectionServerIdentity val = constructObjectPropertyObject "server-identity" val data TlsClientConnectionServerIdentityPropertyInfo instance AttrInfo TlsClientConnectionServerIdentityPropertyInfo where type AttrAllowedOps TlsClientConnectionServerIdentityPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsClientConnectionServerIdentityPropertyInfo = SocketConnectableK type AttrBaseTypeConstraint TlsClientConnectionServerIdentityPropertyInfo = TlsClientConnectionK type AttrGetType TlsClientConnectionServerIdentityPropertyInfo = SocketConnectable type AttrLabel TlsClientConnectionServerIdentityPropertyInfo = "TlsClientConnection::server-identity" attrGet _ = getTlsClientConnectionServerIdentity attrSet _ = setTlsClientConnectionServerIdentity attrConstruct _ = constructTlsClientConnectionServerIdentity -- VVV Prop "use-ssl3" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsClientConnectionUseSsl3 :: (MonadIO m, TlsClientConnectionK o) => o -> m Bool getTlsClientConnectionUseSsl3 obj = liftIO $ getObjectPropertyBool obj "use-ssl3" setTlsClientConnectionUseSsl3 :: (MonadIO m, TlsClientConnectionK o) => o -> Bool -> m () setTlsClientConnectionUseSsl3 obj val = liftIO $ setObjectPropertyBool obj "use-ssl3" val constructTlsClientConnectionUseSsl3 :: Bool -> IO ([Char], GValue) constructTlsClientConnectionUseSsl3 val = constructObjectPropertyBool "use-ssl3" val data TlsClientConnectionUseSsl3PropertyInfo instance AttrInfo TlsClientConnectionUseSsl3PropertyInfo where type AttrAllowedOps TlsClientConnectionUseSsl3PropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsClientConnectionUseSsl3PropertyInfo = (~) Bool type AttrBaseTypeConstraint TlsClientConnectionUseSsl3PropertyInfo = TlsClientConnectionK type AttrGetType TlsClientConnectionUseSsl3PropertyInfo = Bool type AttrLabel TlsClientConnectionUseSsl3PropertyInfo = "TlsClientConnection::use-ssl3" attrGet _ = getTlsClientConnectionUseSsl3 attrSet _ = setTlsClientConnectionUseSsl3 attrConstruct _ = constructTlsClientConnectionUseSsl3 -- VVV Prop "validation-flags" -- Type: TInterface "Gio" "TlsCertificateFlags" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsClientConnectionValidationFlags :: (MonadIO m, TlsClientConnectionK o) => o -> m [TlsCertificateFlags] getTlsClientConnectionValidationFlags obj = liftIO $ getObjectPropertyFlags obj "validation-flags" setTlsClientConnectionValidationFlags :: (MonadIO m, TlsClientConnectionK o) => o -> [TlsCertificateFlags] -> m () setTlsClientConnectionValidationFlags obj val = liftIO $ setObjectPropertyFlags obj "validation-flags" val constructTlsClientConnectionValidationFlags :: [TlsCertificateFlags] -> IO ([Char], GValue) constructTlsClientConnectionValidationFlags val = constructObjectPropertyFlags "validation-flags" val data TlsClientConnectionValidationFlagsPropertyInfo instance AttrInfo TlsClientConnectionValidationFlagsPropertyInfo where type AttrAllowedOps TlsClientConnectionValidationFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsClientConnectionValidationFlagsPropertyInfo = (~) [TlsCertificateFlags] type AttrBaseTypeConstraint TlsClientConnectionValidationFlagsPropertyInfo = TlsClientConnectionK type AttrGetType TlsClientConnectionValidationFlagsPropertyInfo = [TlsCertificateFlags] type AttrLabel TlsClientConnectionValidationFlagsPropertyInfo = "TlsClientConnection::validation-flags" attrGet _ = getTlsClientConnectionValidationFlags attrSet _ = setTlsClientConnectionValidationFlags attrConstruct _ = constructTlsClientConnectionValidationFlags type instance AttributeList TlsClientConnection = '[ '("accepted-cas", TlsClientConnectionAcceptedCasPropertyInfo), '("base-io-stream", TlsConnectionBaseIoStreamPropertyInfo), '("certificate", TlsConnectionCertificatePropertyInfo), '("closed", IOStreamClosedPropertyInfo), '("database", TlsConnectionDatabasePropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("interaction", TlsConnectionInteractionPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("peer-certificate", TlsConnectionPeerCertificatePropertyInfo), '("peer-certificate-errors", TlsConnectionPeerCertificateErrorsPropertyInfo), '("rehandshake-mode", TlsConnectionRehandshakeModePropertyInfo), '("require-close-notify", TlsConnectionRequireCloseNotifyPropertyInfo), '("server-identity", TlsClientConnectionServerIdentityPropertyInfo), '("use-ssl3", TlsClientConnectionUseSsl3PropertyInfo), '("use-system-certdb", TlsConnectionUseSystemCertdbPropertyInfo), '("validation-flags", TlsClientConnectionValidationFlagsPropertyInfo)] -- VVV Prop "base-io-stream" -- Type: TInterface "Gio" "IOStream" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getTlsConnectionBaseIoStream :: (MonadIO m, TlsConnectionK o) => o -> m IOStream getTlsConnectionBaseIoStream obj = liftIO $ getObjectPropertyObject obj "base-io-stream" IOStream constructTlsConnectionBaseIoStream :: (IOStreamK a) => a -> IO ([Char], GValue) constructTlsConnectionBaseIoStream val = constructObjectPropertyObject "base-io-stream" val data TlsConnectionBaseIoStreamPropertyInfo instance AttrInfo TlsConnectionBaseIoStreamPropertyInfo where type AttrAllowedOps TlsConnectionBaseIoStreamPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionBaseIoStreamPropertyInfo = IOStreamK type AttrBaseTypeConstraint TlsConnectionBaseIoStreamPropertyInfo = TlsConnectionK type AttrGetType TlsConnectionBaseIoStreamPropertyInfo = IOStream type AttrLabel TlsConnectionBaseIoStreamPropertyInfo = "TlsConnection::base-io-stream" attrGet _ = getTlsConnectionBaseIoStream attrSet _ = undefined attrConstruct _ = constructTlsConnectionBaseIoStream -- VVV Prop "certificate" -- Type: TInterface "Gio" "TlsCertificate" -- Flags: [PropertyReadable,PropertyWritable] getTlsConnectionCertificate :: (MonadIO m, TlsConnectionK o) => o -> m TlsCertificate getTlsConnectionCertificate obj = liftIO $ getObjectPropertyObject obj "certificate" TlsCertificate setTlsConnectionCertificate :: (MonadIO m, TlsConnectionK o, TlsCertificateK a) => o -> a -> m () setTlsConnectionCertificate obj val = liftIO $ setObjectPropertyObject obj "certificate" val constructTlsConnectionCertificate :: (TlsCertificateK a) => a -> IO ([Char], GValue) constructTlsConnectionCertificate val = constructObjectPropertyObject "certificate" val data TlsConnectionCertificatePropertyInfo instance AttrInfo TlsConnectionCertificatePropertyInfo where type AttrAllowedOps TlsConnectionCertificatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionCertificatePropertyInfo = TlsCertificateK type AttrBaseTypeConstraint TlsConnectionCertificatePropertyInfo = TlsConnectionK type AttrGetType TlsConnectionCertificatePropertyInfo = TlsCertificate type AttrLabel TlsConnectionCertificatePropertyInfo = "TlsConnection::certificate" attrGet _ = getTlsConnectionCertificate attrSet _ = setTlsConnectionCertificate attrConstruct _ = constructTlsConnectionCertificate -- VVV Prop "database" -- Type: TInterface "Gio" "TlsDatabase" -- Flags: [PropertyReadable,PropertyWritable] getTlsConnectionDatabase :: (MonadIO m, TlsConnectionK o) => o -> m TlsDatabase getTlsConnectionDatabase obj = liftIO $ getObjectPropertyObject obj "database" TlsDatabase setTlsConnectionDatabase :: (MonadIO m, TlsConnectionK o, TlsDatabaseK a) => o -> a -> m () setTlsConnectionDatabase obj val = liftIO $ setObjectPropertyObject obj "database" val constructTlsConnectionDatabase :: (TlsDatabaseK a) => a -> IO ([Char], GValue) constructTlsConnectionDatabase val = constructObjectPropertyObject "database" val data TlsConnectionDatabasePropertyInfo instance AttrInfo TlsConnectionDatabasePropertyInfo where type AttrAllowedOps TlsConnectionDatabasePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionDatabasePropertyInfo = TlsDatabaseK type AttrBaseTypeConstraint TlsConnectionDatabasePropertyInfo = TlsConnectionK type AttrGetType TlsConnectionDatabasePropertyInfo = TlsDatabase type AttrLabel TlsConnectionDatabasePropertyInfo = "TlsConnection::database" attrGet _ = getTlsConnectionDatabase attrSet _ = setTlsConnectionDatabase attrConstruct _ = constructTlsConnectionDatabase -- VVV Prop "interaction" -- Type: TInterface "Gio" "TlsInteraction" -- Flags: [PropertyReadable,PropertyWritable] getTlsConnectionInteraction :: (MonadIO m, TlsConnectionK o) => o -> m TlsInteraction getTlsConnectionInteraction obj = liftIO $ getObjectPropertyObject obj "interaction" TlsInteraction setTlsConnectionInteraction :: (MonadIO m, TlsConnectionK o, TlsInteractionK a) => o -> a -> m () setTlsConnectionInteraction obj val = liftIO $ setObjectPropertyObject obj "interaction" val constructTlsConnectionInteraction :: (TlsInteractionK a) => a -> IO ([Char], GValue) constructTlsConnectionInteraction val = constructObjectPropertyObject "interaction" val data TlsConnectionInteractionPropertyInfo instance AttrInfo TlsConnectionInteractionPropertyInfo where type AttrAllowedOps TlsConnectionInteractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionInteractionPropertyInfo = TlsInteractionK type AttrBaseTypeConstraint TlsConnectionInteractionPropertyInfo = TlsConnectionK type AttrGetType TlsConnectionInteractionPropertyInfo = TlsInteraction type AttrLabel TlsConnectionInteractionPropertyInfo = "TlsConnection::interaction" attrGet _ = getTlsConnectionInteraction attrSet _ = setTlsConnectionInteraction attrConstruct _ = constructTlsConnectionInteraction -- VVV Prop "peer-certificate" -- Type: TInterface "Gio" "TlsCertificate" -- Flags: [PropertyReadable] getTlsConnectionPeerCertificate :: (MonadIO m, TlsConnectionK o) => o -> m TlsCertificate getTlsConnectionPeerCertificate obj = liftIO $ getObjectPropertyObject obj "peer-certificate" TlsCertificate data TlsConnectionPeerCertificatePropertyInfo instance AttrInfo TlsConnectionPeerCertificatePropertyInfo where type AttrAllowedOps TlsConnectionPeerCertificatePropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TlsConnectionPeerCertificatePropertyInfo = (~) () type AttrBaseTypeConstraint TlsConnectionPeerCertificatePropertyInfo = TlsConnectionK type AttrGetType TlsConnectionPeerCertificatePropertyInfo = TlsCertificate type AttrLabel TlsConnectionPeerCertificatePropertyInfo = "TlsConnection::peer-certificate" attrGet _ = getTlsConnectionPeerCertificate attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "peer-certificate-errors" -- Type: TInterface "Gio" "TlsCertificateFlags" -- Flags: [PropertyReadable] getTlsConnectionPeerCertificateErrors :: (MonadIO m, TlsConnectionK o) => o -> m [TlsCertificateFlags] getTlsConnectionPeerCertificateErrors obj = liftIO $ getObjectPropertyFlags obj "peer-certificate-errors" data TlsConnectionPeerCertificateErrorsPropertyInfo instance AttrInfo TlsConnectionPeerCertificateErrorsPropertyInfo where type AttrAllowedOps TlsConnectionPeerCertificateErrorsPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint TlsConnectionPeerCertificateErrorsPropertyInfo = (~) () type AttrBaseTypeConstraint TlsConnectionPeerCertificateErrorsPropertyInfo = TlsConnectionK type AttrGetType TlsConnectionPeerCertificateErrorsPropertyInfo = [TlsCertificateFlags] type AttrLabel TlsConnectionPeerCertificateErrorsPropertyInfo = "TlsConnection::peer-certificate-errors" attrGet _ = getTlsConnectionPeerCertificateErrors attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "rehandshake-mode" -- Type: TInterface "Gio" "TlsRehandshakeMode" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsConnectionRehandshakeMode :: (MonadIO m, TlsConnectionK o) => o -> m TlsRehandshakeMode getTlsConnectionRehandshakeMode obj = liftIO $ getObjectPropertyEnum obj "rehandshake-mode" setTlsConnectionRehandshakeMode :: (MonadIO m, TlsConnectionK o) => o -> TlsRehandshakeMode -> m () setTlsConnectionRehandshakeMode obj val = liftIO $ setObjectPropertyEnum obj "rehandshake-mode" val constructTlsConnectionRehandshakeMode :: TlsRehandshakeMode -> IO ([Char], GValue) constructTlsConnectionRehandshakeMode val = constructObjectPropertyEnum "rehandshake-mode" val data TlsConnectionRehandshakeModePropertyInfo instance AttrInfo TlsConnectionRehandshakeModePropertyInfo where type AttrAllowedOps TlsConnectionRehandshakeModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionRehandshakeModePropertyInfo = (~) TlsRehandshakeMode type AttrBaseTypeConstraint TlsConnectionRehandshakeModePropertyInfo = TlsConnectionK type AttrGetType TlsConnectionRehandshakeModePropertyInfo = TlsRehandshakeMode type AttrLabel TlsConnectionRehandshakeModePropertyInfo = "TlsConnection::rehandshake-mode" attrGet _ = getTlsConnectionRehandshakeMode attrSet _ = setTlsConnectionRehandshakeMode attrConstruct _ = constructTlsConnectionRehandshakeMode -- VVV Prop "require-close-notify" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsConnectionRequireCloseNotify :: (MonadIO m, TlsConnectionK o) => o -> m Bool getTlsConnectionRequireCloseNotify obj = liftIO $ getObjectPropertyBool obj "require-close-notify" setTlsConnectionRequireCloseNotify :: (MonadIO m, TlsConnectionK o) => o -> Bool -> m () setTlsConnectionRequireCloseNotify obj val = liftIO $ setObjectPropertyBool obj "require-close-notify" val constructTlsConnectionRequireCloseNotify :: Bool -> IO ([Char], GValue) constructTlsConnectionRequireCloseNotify val = constructObjectPropertyBool "require-close-notify" val data TlsConnectionRequireCloseNotifyPropertyInfo instance AttrInfo TlsConnectionRequireCloseNotifyPropertyInfo where type AttrAllowedOps TlsConnectionRequireCloseNotifyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionRequireCloseNotifyPropertyInfo = (~) Bool type AttrBaseTypeConstraint TlsConnectionRequireCloseNotifyPropertyInfo = TlsConnectionK type AttrGetType TlsConnectionRequireCloseNotifyPropertyInfo = Bool type AttrLabel TlsConnectionRequireCloseNotifyPropertyInfo = "TlsConnection::require-close-notify" attrGet _ = getTlsConnectionRequireCloseNotify attrSet _ = setTlsConnectionRequireCloseNotify attrConstruct _ = constructTlsConnectionRequireCloseNotify -- VVV Prop "use-system-certdb" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsConnectionUseSystemCertdb :: (MonadIO m, TlsConnectionK o) => o -> m Bool getTlsConnectionUseSystemCertdb obj = liftIO $ getObjectPropertyBool obj "use-system-certdb" setTlsConnectionUseSystemCertdb :: (MonadIO m, TlsConnectionK o) => o -> Bool -> m () setTlsConnectionUseSystemCertdb obj val = liftIO $ setObjectPropertyBool obj "use-system-certdb" val constructTlsConnectionUseSystemCertdb :: Bool -> IO ([Char], GValue) constructTlsConnectionUseSystemCertdb val = constructObjectPropertyBool "use-system-certdb" val data TlsConnectionUseSystemCertdbPropertyInfo instance AttrInfo TlsConnectionUseSystemCertdbPropertyInfo where type AttrAllowedOps TlsConnectionUseSystemCertdbPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsConnectionUseSystemCertdbPropertyInfo = (~) Bool type AttrBaseTypeConstraint TlsConnectionUseSystemCertdbPropertyInfo = TlsConnectionK type AttrGetType TlsConnectionUseSystemCertdbPropertyInfo = Bool type AttrLabel TlsConnectionUseSystemCertdbPropertyInfo = "TlsConnection::use-system-certdb" attrGet _ = getTlsConnectionUseSystemCertdb attrSet _ = setTlsConnectionUseSystemCertdb attrConstruct _ = constructTlsConnectionUseSystemCertdb type instance AttributeList TlsConnection = '[ '("base-io-stream", TlsConnectionBaseIoStreamPropertyInfo), '("certificate", TlsConnectionCertificatePropertyInfo), '("closed", IOStreamClosedPropertyInfo), '("database", TlsConnectionDatabasePropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("interaction", TlsConnectionInteractionPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("peer-certificate", TlsConnectionPeerCertificatePropertyInfo), '("peer-certificate-errors", TlsConnectionPeerCertificateErrorsPropertyInfo), '("rehandshake-mode", TlsConnectionRehandshakeModePropertyInfo), '("require-close-notify", TlsConnectionRequireCloseNotifyPropertyInfo), '("use-system-certdb", TlsConnectionUseSystemCertdbPropertyInfo)] type instance AttributeList TlsDatabase = '[ ] -- VVV Prop "anchors" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct] getTlsFileDatabaseAnchors :: (MonadIO m, TlsFileDatabaseK o) => o -> m T.Text getTlsFileDatabaseAnchors obj = liftIO $ getObjectPropertyString obj "anchors" setTlsFileDatabaseAnchors :: (MonadIO m, TlsFileDatabaseK o) => o -> T.Text -> m () setTlsFileDatabaseAnchors obj val = liftIO $ setObjectPropertyString obj "anchors" val constructTlsFileDatabaseAnchors :: T.Text -> IO ([Char], GValue) constructTlsFileDatabaseAnchors val = constructObjectPropertyString "anchors" val data TlsFileDatabaseAnchorsPropertyInfo instance AttrInfo TlsFileDatabaseAnchorsPropertyInfo where type AttrAllowedOps TlsFileDatabaseAnchorsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsFileDatabaseAnchorsPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TlsFileDatabaseAnchorsPropertyInfo = TlsFileDatabaseK type AttrGetType TlsFileDatabaseAnchorsPropertyInfo = T.Text type AttrLabel TlsFileDatabaseAnchorsPropertyInfo = "TlsFileDatabase::anchors" attrGet _ = getTlsFileDatabaseAnchors attrSet _ = setTlsFileDatabaseAnchors attrConstruct _ = constructTlsFileDatabaseAnchors type instance AttributeList TlsFileDatabase = '[ '("anchors", TlsFileDatabaseAnchorsPropertyInfo)] type instance AttributeList TlsInteraction = '[ ] -- VVV Prop "description" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTlsPasswordDescription :: (MonadIO m, TlsPasswordK o) => o -> m T.Text getTlsPasswordDescription obj = liftIO $ getObjectPropertyString obj "description" setTlsPasswordDescription :: (MonadIO m, TlsPasswordK o) => o -> T.Text -> m () setTlsPasswordDescription obj val = liftIO $ setObjectPropertyString obj "description" val constructTlsPasswordDescription :: T.Text -> IO ([Char], GValue) constructTlsPasswordDescription val = constructObjectPropertyString "description" val data TlsPasswordDescriptionPropertyInfo instance AttrInfo TlsPasswordDescriptionPropertyInfo where type AttrAllowedOps TlsPasswordDescriptionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsPasswordDescriptionPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TlsPasswordDescriptionPropertyInfo = TlsPasswordK type AttrGetType TlsPasswordDescriptionPropertyInfo = T.Text type AttrLabel TlsPasswordDescriptionPropertyInfo = "TlsPassword::description" attrGet _ = getTlsPasswordDescription attrSet _ = setTlsPasswordDescription attrConstruct _ = constructTlsPasswordDescription -- VVV Prop "flags" -- Type: TInterface "Gio" "TlsPasswordFlags" -- Flags: [PropertyReadable,PropertyWritable] getTlsPasswordFlags :: (MonadIO m, TlsPasswordK o) => o -> m [TlsPasswordFlags] getTlsPasswordFlags obj = liftIO $ getObjectPropertyFlags obj "flags" setTlsPasswordFlags :: (MonadIO m, TlsPasswordK o) => o -> [TlsPasswordFlags] -> m () setTlsPasswordFlags obj val = liftIO $ setObjectPropertyFlags obj "flags" val constructTlsPasswordFlags :: [TlsPasswordFlags] -> IO ([Char], GValue) constructTlsPasswordFlags val = constructObjectPropertyFlags "flags" val data TlsPasswordFlagsPropertyInfo instance AttrInfo TlsPasswordFlagsPropertyInfo where type AttrAllowedOps TlsPasswordFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsPasswordFlagsPropertyInfo = (~) [TlsPasswordFlags] type AttrBaseTypeConstraint TlsPasswordFlagsPropertyInfo = TlsPasswordK type AttrGetType TlsPasswordFlagsPropertyInfo = [TlsPasswordFlags] type AttrLabel TlsPasswordFlagsPropertyInfo = "TlsPassword::flags" attrGet _ = getTlsPasswordFlags attrSet _ = setTlsPasswordFlags attrConstruct _ = constructTlsPasswordFlags -- VVV Prop "warning" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable] getTlsPasswordWarning :: (MonadIO m, TlsPasswordK o) => o -> m T.Text getTlsPasswordWarning obj = liftIO $ getObjectPropertyString obj "warning" setTlsPasswordWarning :: (MonadIO m, TlsPasswordK o) => o -> T.Text -> m () setTlsPasswordWarning obj val = liftIO $ setObjectPropertyString obj "warning" val constructTlsPasswordWarning :: T.Text -> IO ([Char], GValue) constructTlsPasswordWarning val = constructObjectPropertyString "warning" val data TlsPasswordWarningPropertyInfo instance AttrInfo TlsPasswordWarningPropertyInfo where type AttrAllowedOps TlsPasswordWarningPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsPasswordWarningPropertyInfo = (~) T.Text type AttrBaseTypeConstraint TlsPasswordWarningPropertyInfo = TlsPasswordK type AttrGetType TlsPasswordWarningPropertyInfo = T.Text type AttrLabel TlsPasswordWarningPropertyInfo = "TlsPassword::warning" attrGet _ = getTlsPasswordWarning attrSet _ = setTlsPasswordWarning attrConstruct _ = constructTlsPasswordWarning type instance AttributeList TlsPassword = '[ '("description", TlsPasswordDescriptionPropertyInfo), '("flags", TlsPasswordFlagsPropertyInfo), '("warning", TlsPasswordWarningPropertyInfo)] -- VVV Prop "authentication-mode" -- Type: TInterface "Gio" "TlsAuthenticationMode" -- Flags: [PropertyReadable,PropertyWritable] getTlsServerConnectionAuthenticationMode :: (MonadIO m, TlsServerConnectionK o) => o -> m TlsAuthenticationMode getTlsServerConnectionAuthenticationMode obj = liftIO $ getObjectPropertyEnum obj "authentication-mode" setTlsServerConnectionAuthenticationMode :: (MonadIO m, TlsServerConnectionK o) => o -> TlsAuthenticationMode -> m () setTlsServerConnectionAuthenticationMode obj val = liftIO $ setObjectPropertyEnum obj "authentication-mode" val constructTlsServerConnectionAuthenticationMode :: TlsAuthenticationMode -> IO ([Char], GValue) constructTlsServerConnectionAuthenticationMode val = constructObjectPropertyEnum "authentication-mode" val data TlsServerConnectionAuthenticationModePropertyInfo instance AttrInfo TlsServerConnectionAuthenticationModePropertyInfo where type AttrAllowedOps TlsServerConnectionAuthenticationModePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint TlsServerConnectionAuthenticationModePropertyInfo = (~) TlsAuthenticationMode type AttrBaseTypeConstraint TlsServerConnectionAuthenticationModePropertyInfo = TlsServerConnectionK type AttrGetType TlsServerConnectionAuthenticationModePropertyInfo = TlsAuthenticationMode type AttrLabel TlsServerConnectionAuthenticationModePropertyInfo = "TlsServerConnection::authentication-mode" attrGet _ = getTlsServerConnectionAuthenticationMode attrSet _ = setTlsServerConnectionAuthenticationMode attrConstruct _ = constructTlsServerConnectionAuthenticationMode type instance AttributeList TlsServerConnection = '[ '("authentication-mode", TlsServerConnectionAuthenticationModePropertyInfo), '("base-io-stream", TlsConnectionBaseIoStreamPropertyInfo), '("certificate", TlsConnectionCertificatePropertyInfo), '("closed", IOStreamClosedPropertyInfo), '("database", TlsConnectionDatabasePropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("interaction", TlsConnectionInteractionPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("peer-certificate", TlsConnectionPeerCertificatePropertyInfo), '("peer-certificate-errors", TlsConnectionPeerCertificateErrorsPropertyInfo), '("rehandshake-mode", TlsConnectionRehandshakeModePropertyInfo), '("require-close-notify", TlsConnectionRequireCloseNotifyPropertyInfo), '("use-system-certdb", TlsConnectionUseSystemCertdbPropertyInfo)] type instance AttributeList UnixConnection = '[ '("closed", IOStreamClosedPropertyInfo), '("input-stream", IOStreamInputStreamPropertyInfo), '("output-stream", IOStreamOutputStreamPropertyInfo), '("socket", SocketConnectionSocketPropertyInfo)] -- VVV Prop "credentials" -- Type: TInterface "Gio" "Credentials" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixCredentialsMessageCredentials :: (MonadIO m, UnixCredentialsMessageK o) => o -> m Credentials getUnixCredentialsMessageCredentials obj = liftIO $ getObjectPropertyObject obj "credentials" Credentials constructUnixCredentialsMessageCredentials :: (CredentialsK a) => a -> IO ([Char], GValue) constructUnixCredentialsMessageCredentials val = constructObjectPropertyObject "credentials" val data UnixCredentialsMessageCredentialsPropertyInfo instance AttrInfo UnixCredentialsMessageCredentialsPropertyInfo where type AttrAllowedOps UnixCredentialsMessageCredentialsPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixCredentialsMessageCredentialsPropertyInfo = CredentialsK type AttrBaseTypeConstraint UnixCredentialsMessageCredentialsPropertyInfo = UnixCredentialsMessageK type AttrGetType UnixCredentialsMessageCredentialsPropertyInfo = Credentials type AttrLabel UnixCredentialsMessageCredentialsPropertyInfo = "UnixCredentialsMessage::credentials" attrGet _ = getUnixCredentialsMessageCredentials attrSet _ = undefined attrConstruct _ = constructUnixCredentialsMessageCredentials type instance AttributeList UnixCredentialsMessage = '[ '("credentials", UnixCredentialsMessageCredentialsPropertyInfo)] type instance AttributeList UnixFDList = '[ ] -- VVV Prop "fd-list" -- Type: TInterface "Gio" "UnixFDList" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixFDMessageFdList :: (MonadIO m, UnixFDMessageK o) => o -> m UnixFDList getUnixFDMessageFdList obj = liftIO $ getObjectPropertyObject obj "fd-list" UnixFDList constructUnixFDMessageFdList :: (UnixFDListK a) => a -> IO ([Char], GValue) constructUnixFDMessageFdList val = constructObjectPropertyObject "fd-list" val data UnixFDMessageFdListPropertyInfo instance AttrInfo UnixFDMessageFdListPropertyInfo where type AttrAllowedOps UnixFDMessageFdListPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixFDMessageFdListPropertyInfo = UnixFDListK type AttrBaseTypeConstraint UnixFDMessageFdListPropertyInfo = UnixFDMessageK type AttrGetType UnixFDMessageFdListPropertyInfo = UnixFDList type AttrLabel UnixFDMessageFdListPropertyInfo = "UnixFDMessage::fd-list" attrGet _ = getUnixFDMessageFdList attrSet _ = undefined attrConstruct _ = constructUnixFDMessageFdList type instance AttributeList UnixFDMessage = '[ '("fd-list", UnixFDMessageFdListPropertyInfo)] -- VVV Prop "close-fd" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getUnixInputStreamCloseFd :: (MonadIO m, UnixInputStreamK o) => o -> m Bool getUnixInputStreamCloseFd obj = liftIO $ getObjectPropertyBool obj "close-fd" setUnixInputStreamCloseFd :: (MonadIO m, UnixInputStreamK o) => o -> Bool -> m () setUnixInputStreamCloseFd obj val = liftIO $ setObjectPropertyBool obj "close-fd" val constructUnixInputStreamCloseFd :: Bool -> IO ([Char], GValue) constructUnixInputStreamCloseFd val = constructObjectPropertyBool "close-fd" val data UnixInputStreamCloseFdPropertyInfo instance AttrInfo UnixInputStreamCloseFdPropertyInfo where type AttrAllowedOps UnixInputStreamCloseFdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixInputStreamCloseFdPropertyInfo = (~) Bool type AttrBaseTypeConstraint UnixInputStreamCloseFdPropertyInfo = UnixInputStreamK type AttrGetType UnixInputStreamCloseFdPropertyInfo = Bool type AttrLabel UnixInputStreamCloseFdPropertyInfo = "UnixInputStream::close-fd" attrGet _ = getUnixInputStreamCloseFd attrSet _ = setUnixInputStreamCloseFd attrConstruct _ = constructUnixInputStreamCloseFd -- VVV Prop "fd" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixInputStreamFd :: (MonadIO m, UnixInputStreamK o) => o -> m Int32 getUnixInputStreamFd obj = liftIO $ getObjectPropertyCInt obj "fd" constructUnixInputStreamFd :: Int32 -> IO ([Char], GValue) constructUnixInputStreamFd val = constructObjectPropertyCInt "fd" val data UnixInputStreamFdPropertyInfo instance AttrInfo UnixInputStreamFdPropertyInfo where type AttrAllowedOps UnixInputStreamFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixInputStreamFdPropertyInfo = (~) Int32 type AttrBaseTypeConstraint UnixInputStreamFdPropertyInfo = UnixInputStreamK type AttrGetType UnixInputStreamFdPropertyInfo = Int32 type AttrLabel UnixInputStreamFdPropertyInfo = "UnixInputStream::fd" attrGet _ = getUnixInputStreamFd attrSet _ = undefined attrConstruct _ = constructUnixInputStreamFd type instance AttributeList UnixInputStream = '[ '("close-fd", UnixInputStreamCloseFdPropertyInfo), '("fd", UnixInputStreamFdPropertyInfo)] type instance AttributeList UnixMountMonitor = '[ ] -- VVV Prop "close-fd" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable] getUnixOutputStreamCloseFd :: (MonadIO m, UnixOutputStreamK o) => o -> m Bool getUnixOutputStreamCloseFd obj = liftIO $ getObjectPropertyBool obj "close-fd" setUnixOutputStreamCloseFd :: (MonadIO m, UnixOutputStreamK o) => o -> Bool -> m () setUnixOutputStreamCloseFd obj val = liftIO $ setObjectPropertyBool obj "close-fd" val constructUnixOutputStreamCloseFd :: Bool -> IO ([Char], GValue) constructUnixOutputStreamCloseFd val = constructObjectPropertyBool "close-fd" val data UnixOutputStreamCloseFdPropertyInfo instance AttrInfo UnixOutputStreamCloseFdPropertyInfo where type AttrAllowedOps UnixOutputStreamCloseFdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixOutputStreamCloseFdPropertyInfo = (~) Bool type AttrBaseTypeConstraint UnixOutputStreamCloseFdPropertyInfo = UnixOutputStreamK type AttrGetType UnixOutputStreamCloseFdPropertyInfo = Bool type AttrLabel UnixOutputStreamCloseFdPropertyInfo = "UnixOutputStream::close-fd" attrGet _ = getUnixOutputStreamCloseFd attrSet _ = setUnixOutputStreamCloseFd attrConstruct _ = constructUnixOutputStreamCloseFd -- VVV Prop "fd" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixOutputStreamFd :: (MonadIO m, UnixOutputStreamK o) => o -> m Int32 getUnixOutputStreamFd obj = liftIO $ getObjectPropertyCInt obj "fd" constructUnixOutputStreamFd :: Int32 -> IO ([Char], GValue) constructUnixOutputStreamFd val = constructObjectPropertyCInt "fd" val data UnixOutputStreamFdPropertyInfo instance AttrInfo UnixOutputStreamFdPropertyInfo where type AttrAllowedOps UnixOutputStreamFdPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixOutputStreamFdPropertyInfo = (~) Int32 type AttrBaseTypeConstraint UnixOutputStreamFdPropertyInfo = UnixOutputStreamK type AttrGetType UnixOutputStreamFdPropertyInfo = Int32 type AttrLabel UnixOutputStreamFdPropertyInfo = "UnixOutputStream::fd" attrGet _ = getUnixOutputStreamFd attrSet _ = undefined attrConstruct _ = constructUnixOutputStreamFd type instance AttributeList UnixOutputStream = '[ '("close-fd", UnixOutputStreamCloseFdPropertyInfo), '("fd", UnixOutputStreamFdPropertyInfo)] -- VVV Prop "abstract" -- Type: TBasicType TBoolean -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixSocketAddressAbstract :: (MonadIO m, UnixSocketAddressK o) => o -> m Bool getUnixSocketAddressAbstract obj = liftIO $ getObjectPropertyBool obj "abstract" constructUnixSocketAddressAbstract :: Bool -> IO ([Char], GValue) constructUnixSocketAddressAbstract val = constructObjectPropertyBool "abstract" val data UnixSocketAddressAbstractPropertyInfo instance AttrInfo UnixSocketAddressAbstractPropertyInfo where type AttrAllowedOps UnixSocketAddressAbstractPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixSocketAddressAbstractPropertyInfo = (~) Bool type AttrBaseTypeConstraint UnixSocketAddressAbstractPropertyInfo = UnixSocketAddressK type AttrGetType UnixSocketAddressAbstractPropertyInfo = Bool type AttrLabel UnixSocketAddressAbstractPropertyInfo = "UnixSocketAddress::abstract" attrGet _ = getUnixSocketAddressAbstract attrSet _ = undefined attrConstruct _ = constructUnixSocketAddressAbstract -- VVV Prop "address-type" -- Type: TInterface "Gio" "UnixSocketAddressType" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixSocketAddressAddressType :: (MonadIO m, UnixSocketAddressK o) => o -> m UnixSocketAddressType getUnixSocketAddressAddressType obj = liftIO $ getObjectPropertyEnum obj "address-type" constructUnixSocketAddressAddressType :: UnixSocketAddressType -> IO ([Char], GValue) constructUnixSocketAddressAddressType val = constructObjectPropertyEnum "address-type" val data UnixSocketAddressAddressTypePropertyInfo instance AttrInfo UnixSocketAddressAddressTypePropertyInfo where type AttrAllowedOps UnixSocketAddressAddressTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixSocketAddressAddressTypePropertyInfo = (~) UnixSocketAddressType type AttrBaseTypeConstraint UnixSocketAddressAddressTypePropertyInfo = UnixSocketAddressK type AttrGetType UnixSocketAddressAddressTypePropertyInfo = UnixSocketAddressType type AttrLabel UnixSocketAddressAddressTypePropertyInfo = "UnixSocketAddress::address-type" attrGet _ = getUnixSocketAddressAddressType attrSet _ = undefined attrConstruct _ = constructUnixSocketAddressAddressType -- VVV Prop "path" -- Type: TBasicType TUTF8 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixSocketAddressPath :: (MonadIO m, UnixSocketAddressK o) => o -> m T.Text getUnixSocketAddressPath obj = liftIO $ getObjectPropertyString obj "path" constructUnixSocketAddressPath :: T.Text -> IO ([Char], GValue) constructUnixSocketAddressPath val = constructObjectPropertyString "path" val data UnixSocketAddressPathPropertyInfo instance AttrInfo UnixSocketAddressPathPropertyInfo where type AttrAllowedOps UnixSocketAddressPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixSocketAddressPathPropertyInfo = (~) T.Text type AttrBaseTypeConstraint UnixSocketAddressPathPropertyInfo = UnixSocketAddressK type AttrGetType UnixSocketAddressPathPropertyInfo = T.Text type AttrLabel UnixSocketAddressPathPropertyInfo = "UnixSocketAddress::path" attrGet _ = getUnixSocketAddressPath attrSet _ = undefined attrConstruct _ = constructUnixSocketAddressPath -- VVV Prop "path-as-array" -- Type: TByteArray -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getUnixSocketAddressPathAsArray :: (MonadIO m, UnixSocketAddressK o) => o -> m ByteString getUnixSocketAddressPathAsArray obj = liftIO $ getObjectPropertyByteArray obj "path-as-array" constructUnixSocketAddressPathAsArray :: ByteString -> IO ([Char], GValue) constructUnixSocketAddressPathAsArray val = constructObjectPropertyByteArray "path-as-array" val data UnixSocketAddressPathAsArrayPropertyInfo instance AttrInfo UnixSocketAddressPathAsArrayPropertyInfo where type AttrAllowedOps UnixSocketAddressPathAsArrayPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint UnixSocketAddressPathAsArrayPropertyInfo = (~) ByteString type AttrBaseTypeConstraint UnixSocketAddressPathAsArrayPropertyInfo = UnixSocketAddressK type AttrGetType UnixSocketAddressPathAsArrayPropertyInfo = ByteString type AttrLabel UnixSocketAddressPathAsArrayPropertyInfo = "UnixSocketAddress::path-as-array" attrGet _ = getUnixSocketAddressPathAsArray attrSet _ = undefined attrConstruct _ = constructUnixSocketAddressPathAsArray type instance AttributeList UnixSocketAddress = '[ '("abstract", UnixSocketAddressAbstractPropertyInfo), '("address-type", UnixSocketAddressAddressTypePropertyInfo), '("family", SocketAddressFamilyPropertyInfo), '("path", UnixSocketAddressPathPropertyInfo), '("path-as-array", UnixSocketAddressPathAsArrayPropertyInfo)] type instance AttributeList Vfs = '[ ] type instance AttributeList Volume = '[ ] type instance AttributeList VolumeMonitor = '[ ] -- VVV Prop "file-info" -- Type: TInterface "Gio" "FileInfo" -- Flags: [PropertyReadable,PropertyWritable] getZlibCompressorFileInfo :: (MonadIO m, ZlibCompressorK o) => o -> m FileInfo getZlibCompressorFileInfo obj = liftIO $ getObjectPropertyObject obj "file-info" FileInfo setZlibCompressorFileInfo :: (MonadIO m, ZlibCompressorK o, FileInfoK a) => o -> a -> m () setZlibCompressorFileInfo obj val = liftIO $ setObjectPropertyObject obj "file-info" val constructZlibCompressorFileInfo :: (FileInfoK a) => a -> IO ([Char], GValue) constructZlibCompressorFileInfo val = constructObjectPropertyObject "file-info" val data ZlibCompressorFileInfoPropertyInfo instance AttrInfo ZlibCompressorFileInfoPropertyInfo where type AttrAllowedOps ZlibCompressorFileInfoPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ZlibCompressorFileInfoPropertyInfo = FileInfoK type AttrBaseTypeConstraint ZlibCompressorFileInfoPropertyInfo = ZlibCompressorK type AttrGetType ZlibCompressorFileInfoPropertyInfo = FileInfo type AttrLabel ZlibCompressorFileInfoPropertyInfo = "ZlibCompressor::file-info" attrGet _ = getZlibCompressorFileInfo attrSet _ = setZlibCompressorFileInfo attrConstruct _ = constructZlibCompressorFileInfo -- VVV Prop "format" -- Type: TInterface "Gio" "ZlibCompressorFormat" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getZlibCompressorFormat :: (MonadIO m, ZlibCompressorK o) => o -> m ZlibCompressorFormat getZlibCompressorFormat obj = liftIO $ getObjectPropertyEnum obj "format" constructZlibCompressorFormat :: ZlibCompressorFormat -> IO ([Char], GValue) constructZlibCompressorFormat val = constructObjectPropertyEnum "format" val data ZlibCompressorFormatPropertyInfo instance AttrInfo ZlibCompressorFormatPropertyInfo where type AttrAllowedOps ZlibCompressorFormatPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ZlibCompressorFormatPropertyInfo = (~) ZlibCompressorFormat type AttrBaseTypeConstraint ZlibCompressorFormatPropertyInfo = ZlibCompressorK type AttrGetType ZlibCompressorFormatPropertyInfo = ZlibCompressorFormat type AttrLabel ZlibCompressorFormatPropertyInfo = "ZlibCompressor::format" attrGet _ = getZlibCompressorFormat attrSet _ = undefined attrConstruct _ = constructZlibCompressorFormat -- VVV Prop "level" -- Type: TBasicType TInt32 -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getZlibCompressorLevel :: (MonadIO m, ZlibCompressorK o) => o -> m Int32 getZlibCompressorLevel obj = liftIO $ getObjectPropertyCInt obj "level" constructZlibCompressorLevel :: Int32 -> IO ([Char], GValue) constructZlibCompressorLevel val = constructObjectPropertyCInt "level" val data ZlibCompressorLevelPropertyInfo instance AttrInfo ZlibCompressorLevelPropertyInfo where type AttrAllowedOps ZlibCompressorLevelPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ZlibCompressorLevelPropertyInfo = (~) Int32 type AttrBaseTypeConstraint ZlibCompressorLevelPropertyInfo = ZlibCompressorK type AttrGetType ZlibCompressorLevelPropertyInfo = Int32 type AttrLabel ZlibCompressorLevelPropertyInfo = "ZlibCompressor::level" attrGet _ = getZlibCompressorLevel attrSet _ = undefined attrConstruct _ = constructZlibCompressorLevel type instance AttributeList ZlibCompressor = '[ '("file-info", ZlibCompressorFileInfoPropertyInfo), '("format", ZlibCompressorFormatPropertyInfo), '("level", ZlibCompressorLevelPropertyInfo)] -- VVV Prop "file-info" -- Type: TInterface "Gio" "FileInfo" -- Flags: [PropertyReadable] getZlibDecompressorFileInfo :: (MonadIO m, ZlibDecompressorK o) => o -> m FileInfo getZlibDecompressorFileInfo obj = liftIO $ getObjectPropertyObject obj "file-info" FileInfo data ZlibDecompressorFileInfoPropertyInfo instance AttrInfo ZlibDecompressorFileInfoPropertyInfo where type AttrAllowedOps ZlibDecompressorFileInfoPropertyInfo = '[ 'AttrGet] type AttrSetTypeConstraint ZlibDecompressorFileInfoPropertyInfo = (~) () type AttrBaseTypeConstraint ZlibDecompressorFileInfoPropertyInfo = ZlibDecompressorK type AttrGetType ZlibDecompressorFileInfoPropertyInfo = FileInfo type AttrLabel ZlibDecompressorFileInfoPropertyInfo = "ZlibDecompressor::file-info" attrGet _ = getZlibDecompressorFileInfo attrSet _ = undefined attrConstruct _ = undefined -- VVV Prop "format" -- Type: TInterface "Gio" "ZlibCompressorFormat" -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly] getZlibDecompressorFormat :: (MonadIO m, ZlibDecompressorK o) => o -> m ZlibCompressorFormat getZlibDecompressorFormat obj = liftIO $ getObjectPropertyEnum obj "format" constructZlibDecompressorFormat :: ZlibCompressorFormat -> IO ([Char], GValue) constructZlibDecompressorFormat val = constructObjectPropertyEnum "format" val data ZlibDecompressorFormatPropertyInfo instance AttrInfo ZlibDecompressorFormatPropertyInfo where type AttrAllowedOps ZlibDecompressorFormatPropertyInfo = '[ 'AttrConstruct, 'AttrGet] type AttrSetTypeConstraint ZlibDecompressorFormatPropertyInfo = (~) ZlibCompressorFormat type AttrBaseTypeConstraint ZlibDecompressorFormatPropertyInfo = ZlibDecompressorK type AttrGetType ZlibDecompressorFormatPropertyInfo = ZlibCompressorFormat type AttrLabel ZlibDecompressorFormatPropertyInfo = "ZlibDecompressor::format" attrGet _ = getZlibDecompressorFormat attrSet _ = undefined attrConstruct _ = constructZlibDecompressorFormat type instance AttributeList ZlibDecompressor = '[ '("file-info", ZlibDecompressorFileInfoPropertyInfo), '("format", ZlibDecompressorFormatPropertyInfo)]