#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \
&& !defined(__HADDOCK_VERSION__))
module GI.Gtk.Structs.IMContextInfo
(
IMContextInfo(..) ,
newZeroIMContextInfo ,
noIMContextInfo ,
clearIMContextInfoContextId ,
getIMContextInfoContextId ,
#if ENABLE_OVERLOADING
iMContextInfo_contextId ,
#endif
setIMContextInfoContextId ,
clearIMContextInfoContextName ,
getIMContextInfoContextName ,
#if ENABLE_OVERLOADING
iMContextInfo_contextName ,
#endif
setIMContextInfoContextName ,
clearIMContextInfoDefaultLocales ,
getIMContextInfoDefaultLocales ,
#if ENABLE_OVERLOADING
iMContextInfo_defaultLocales ,
#endif
setIMContextInfoDefaultLocales ,
clearIMContextInfoDomain ,
getIMContextInfoDomain ,
#if ENABLE_OVERLOADING
iMContextInfo_domain ,
#endif
setIMContextInfoDomain ,
clearIMContextInfoDomainDirname ,
getIMContextInfoDomainDirname ,
#if ENABLE_OVERLOADING
iMContextInfo_domainDirname ,
#endif
setIMContextInfoDomainDirname ,
) where
import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P
import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
newtype IMContextInfo = IMContextInfo (ManagedPtr IMContextInfo)
instance WrappedPtr IMContextInfo where
wrappedPtrCalloc = callocBytes 40
wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 40 >=> wrapPtr IMContextInfo)
wrappedPtrFree = Just ptr_to_g_free
newZeroIMContextInfo :: MonadIO m => m IMContextInfo
newZeroIMContextInfo = liftIO $ wrappedPtrCalloc >>= wrapPtr IMContextInfo
instance tag ~ 'AttrSet => Constructible IMContextInfo tag where
new _ attrs = do
o <- newZeroIMContextInfo
GI.Attributes.set o attrs
return o
noIMContextInfo :: Maybe IMContextInfo
noIMContextInfo = Nothing
getIMContextInfoContextId :: MonadIO m => IMContextInfo -> m (Maybe T.Text)
getIMContextInfoContextId s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 0) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setIMContextInfoContextId :: MonadIO m => IMContextInfo -> CString -> m ()
setIMContextInfoContextId s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (val :: CString)
clearIMContextInfoContextId :: MonadIO m => IMContextInfo -> m ()
clearIMContextInfoContextId s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)
#if ENABLE_OVERLOADING
data IMContextInfoContextIdFieldInfo
instance AttrInfo IMContextInfoContextIdFieldInfo where
type AttrAllowedOps IMContextInfoContextIdFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint IMContextInfoContextIdFieldInfo = (~) CString
type AttrBaseTypeConstraint IMContextInfoContextIdFieldInfo = (~) IMContextInfo
type AttrGetType IMContextInfoContextIdFieldInfo = Maybe T.Text
type AttrLabel IMContextInfoContextIdFieldInfo = "context_id"
type AttrOrigin IMContextInfoContextIdFieldInfo = IMContextInfo
attrGet _ = getIMContextInfoContextId
attrSet _ = setIMContextInfoContextId
attrConstruct = undefined
attrClear _ = clearIMContextInfoContextId
iMContextInfo_contextId :: AttrLabelProxy "contextId"
iMContextInfo_contextId = AttrLabelProxy
#endif
getIMContextInfoContextName :: MonadIO m => IMContextInfo -> m (Maybe T.Text)
getIMContextInfoContextName s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 8) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setIMContextInfoContextName :: MonadIO m => IMContextInfo -> CString -> m ()
setIMContextInfoContextName s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 8) (val :: CString)
clearIMContextInfoContextName :: MonadIO m => IMContextInfo -> m ()
clearIMContextInfoContextName s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)
#if ENABLE_OVERLOADING
data IMContextInfoContextNameFieldInfo
instance AttrInfo IMContextInfoContextNameFieldInfo where
type AttrAllowedOps IMContextInfoContextNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint IMContextInfoContextNameFieldInfo = (~) CString
type AttrBaseTypeConstraint IMContextInfoContextNameFieldInfo = (~) IMContextInfo
type AttrGetType IMContextInfoContextNameFieldInfo = Maybe T.Text
type AttrLabel IMContextInfoContextNameFieldInfo = "context_name"
type AttrOrigin IMContextInfoContextNameFieldInfo = IMContextInfo
attrGet _ = getIMContextInfoContextName
attrSet _ = setIMContextInfoContextName
attrConstruct = undefined
attrClear _ = clearIMContextInfoContextName
iMContextInfo_contextName :: AttrLabelProxy "contextName"
iMContextInfo_contextName = AttrLabelProxy
#endif
getIMContextInfoDomain :: MonadIO m => IMContextInfo -> m (Maybe T.Text)
getIMContextInfoDomain s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 16) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setIMContextInfoDomain :: MonadIO m => IMContextInfo -> CString -> m ()
setIMContextInfoDomain s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 16) (val :: CString)
clearIMContextInfoDomain :: MonadIO m => IMContextInfo -> m ()
clearIMContextInfoDomain s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)
#if ENABLE_OVERLOADING
data IMContextInfoDomainFieldInfo
instance AttrInfo IMContextInfoDomainFieldInfo where
type AttrAllowedOps IMContextInfoDomainFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint IMContextInfoDomainFieldInfo = (~) CString
type AttrBaseTypeConstraint IMContextInfoDomainFieldInfo = (~) IMContextInfo
type AttrGetType IMContextInfoDomainFieldInfo = Maybe T.Text
type AttrLabel IMContextInfoDomainFieldInfo = "domain"
type AttrOrigin IMContextInfoDomainFieldInfo = IMContextInfo
attrGet _ = getIMContextInfoDomain
attrSet _ = setIMContextInfoDomain
attrConstruct = undefined
attrClear _ = clearIMContextInfoDomain
iMContextInfo_domain :: AttrLabelProxy "domain"
iMContextInfo_domain = AttrLabelProxy
#endif
getIMContextInfoDomainDirname :: MonadIO m => IMContextInfo -> m (Maybe T.Text)
getIMContextInfoDomainDirname s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 24) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setIMContextInfoDomainDirname :: MonadIO m => IMContextInfo -> CString -> m ()
setIMContextInfoDomainDirname s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 24) (val :: CString)
clearIMContextInfoDomainDirname :: MonadIO m => IMContextInfo -> m ()
clearIMContextInfoDomainDirname s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 24) (FP.nullPtr :: CString)
#if ENABLE_OVERLOADING
data IMContextInfoDomainDirnameFieldInfo
instance AttrInfo IMContextInfoDomainDirnameFieldInfo where
type AttrAllowedOps IMContextInfoDomainDirnameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint IMContextInfoDomainDirnameFieldInfo = (~) CString
type AttrBaseTypeConstraint IMContextInfoDomainDirnameFieldInfo = (~) IMContextInfo
type AttrGetType IMContextInfoDomainDirnameFieldInfo = Maybe T.Text
type AttrLabel IMContextInfoDomainDirnameFieldInfo = "domain_dirname"
type AttrOrigin IMContextInfoDomainDirnameFieldInfo = IMContextInfo
attrGet _ = getIMContextInfoDomainDirname
attrSet _ = setIMContextInfoDomainDirname
attrConstruct = undefined
attrClear _ = clearIMContextInfoDomainDirname
iMContextInfo_domainDirname :: AttrLabelProxy "domainDirname"
iMContextInfo_domainDirname = AttrLabelProxy
#endif
getIMContextInfoDefaultLocales :: MonadIO m => IMContextInfo -> m (Maybe T.Text)
getIMContextInfoDefaultLocales s = liftIO $ withManagedPtr s $ \ptr -> do
val <- peek (ptr `plusPtr` 32) :: IO CString
result <- SP.convertIfNonNull val $ \val' -> do
val'' <- cstringToText val'
return val''
return result
setIMContextInfoDefaultLocales :: MonadIO m => IMContextInfo -> CString -> m ()
setIMContextInfoDefaultLocales s val = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 32) (val :: CString)
clearIMContextInfoDefaultLocales :: MonadIO m => IMContextInfo -> m ()
clearIMContextInfoDefaultLocales s = liftIO $ withManagedPtr s $ \ptr -> do
poke (ptr `plusPtr` 32) (FP.nullPtr :: CString)
#if ENABLE_OVERLOADING
data IMContextInfoDefaultLocalesFieldInfo
instance AttrInfo IMContextInfoDefaultLocalesFieldInfo where
type AttrAllowedOps IMContextInfoDefaultLocalesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
type AttrSetTypeConstraint IMContextInfoDefaultLocalesFieldInfo = (~) CString
type AttrBaseTypeConstraint IMContextInfoDefaultLocalesFieldInfo = (~) IMContextInfo
type AttrGetType IMContextInfoDefaultLocalesFieldInfo = Maybe T.Text
type AttrLabel IMContextInfoDefaultLocalesFieldInfo = "default_locales"
type AttrOrigin IMContextInfoDefaultLocalesFieldInfo = IMContextInfo
attrGet _ = getIMContextInfoDefaultLocales
attrSet _ = setIMContextInfoDefaultLocales
attrConstruct = undefined
attrClear _ = clearIMContextInfoDefaultLocales
iMContextInfo_defaultLocales :: AttrLabelProxy "defaultLocales"
iMContextInfo_defaultLocales = AttrLabelProxy
#endif
#if ENABLE_OVERLOADING
instance O.HasAttributeList IMContextInfo
type instance O.AttributeList IMContextInfo = IMContextInfoAttributeList
type IMContextInfoAttributeList = ('[ '("contextId", IMContextInfoContextIdFieldInfo), '("contextName", IMContextInfoContextNameFieldInfo), '("domain", IMContextInfoDomainFieldInfo), '("domainDirname", IMContextInfoDomainDirnameFieldInfo), '("defaultLocales", IMContextInfoDefaultLocalesFieldInfo)] :: [(Symbol, *)])
#endif
#if ENABLE_OVERLOADING
type family ResolveIMContextInfoMethod (t :: Symbol) (o :: *) :: * where
ResolveIMContextInfoMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveIMContextInfoMethod t IMContextInfo, O.MethodInfo info IMContextInfo p) => O.IsLabelProxy t (IMContextInfo -> p) where
fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveIMContextInfoMethod t IMContextInfo, O.MethodInfo info IMContextInfo p) => O.IsLabel t (IMContextInfo -> p) where
#if MIN_VERSION_base(4,10,0)
fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif
#endif