{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

Bookkeeping information about a loadable input method.
-}

module GI.Gtk.Structs.IMContextInfo
    ( 

-- * Exported types
    IMContextInfo(..)                       ,
    newZeroIMContextInfo                    ,
    noIMContextInfo                         ,


 -- * Properties
-- ** contextId #attr:contextId#
    clearIMContextInfoContextId             ,
    getIMContextInfoContextId               ,
    iMContextInfo_contextId                 ,
    setIMContextInfoContextId               ,


-- ** contextName #attr:contextName#
    clearIMContextInfoContextName           ,
    getIMContextInfoContextName             ,
    iMContextInfo_contextName               ,
    setIMContextInfoContextName             ,


-- ** defaultLocales #attr:defaultLocales#
    clearIMContextInfoDefaultLocales        ,
    getIMContextInfoDefaultLocales          ,
    iMContextInfo_defaultLocales            ,
    setIMContextInfoDefaultLocales          ,


-- ** domain #attr:domain#
    clearIMContextInfoDomain                ,
    getIMContextInfoDomain                  ,
    iMContextInfo_domain                    ,
    setIMContextInfoDomain                  ,


-- ** domainDirname #attr:domainDirname#
    clearIMContextInfoDomainDirname         ,
    getIMContextInfoDomainDirname           ,
    iMContextInfo_domainDirname             ,
    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.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

-- | Construct a `IMContextInfo` struct initialized to zero.
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)

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


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)

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


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)

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


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)

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


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)

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



instance O.HasAttributeList IMContextInfo
type instance O.AttributeList IMContextInfo = IMContextInfoAttributeList
type IMContextInfoAttributeList = ('[ '("contextId", IMContextInfoContextIdFieldInfo), '("contextName", IMContextInfoContextNameFieldInfo), '("domain", IMContextInfoDomainFieldInfo), '("domainDirname", IMContextInfoDomainDirnameFieldInfo), '("defaultLocales", IMContextInfoDefaultLocalesFieldInfo)] :: [(Symbol, *)])

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
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif