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

Encapsulates information about a key event.
-}

module GI.Atk.Structs.KeyEventStruct
    ( 

-- * Exported types
    KeyEventStruct(..)                      ,
    newZeroKeyEventStruct                   ,
    noKeyEventStruct                        ,


 -- * Properties
-- ** keycode #attr:keycode#
    getKeyEventStructKeycode                ,
    keyEventStruct_keycode                  ,
    setKeyEventStructKeycode                ,


-- ** keyval #attr:keyval#
    getKeyEventStructKeyval                 ,
    keyEventStruct_keyval                   ,
    setKeyEventStructKeyval                 ,


-- ** length #attr:length#
    getKeyEventStructLength                 ,
    keyEventStruct_length                   ,
    setKeyEventStructLength                 ,


-- ** state #attr:state#
    getKeyEventStructState                  ,
    keyEventStruct_state                    ,
    setKeyEventStructState                  ,


-- ** string #attr:string#
    clearKeyEventStructString               ,
    getKeyEventStructString                 ,
    keyEventStruct_string                   ,
    setKeyEventStructString                 ,


-- ** timestamp #attr:timestamp#
    getKeyEventStructTimestamp              ,
    keyEventStruct_timestamp                ,
    setKeyEventStructTimestamp              ,


-- ** type #attr:type#
    getKeyEventStructType                   ,
    keyEventStruct_type                     ,
    setKeyEventStructType                   ,




    ) 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 KeyEventStruct = KeyEventStruct (ManagedPtr KeyEventStruct)
instance WrappedPtr KeyEventStruct where
    wrappedPtrCalloc = callocBytes 32
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 32 >=> wrapPtr KeyEventStruct)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `KeyEventStruct` struct initialized to zero.
newZeroKeyEventStruct :: MonadIO m => m KeyEventStruct
newZeroKeyEventStruct = liftIO $ wrappedPtrCalloc >>= wrapPtr KeyEventStruct

instance tag ~ 'AttrSet => Constructible KeyEventStruct tag where
    new _ attrs = do
        o <- newZeroKeyEventStruct
        GI.Attributes.set o attrs
        return o


noKeyEventStruct :: Maybe KeyEventStruct
noKeyEventStruct = Nothing

getKeyEventStructType :: MonadIO m => KeyEventStruct -> m Int32
getKeyEventStructType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO Int32
    return val

setKeyEventStructType :: MonadIO m => KeyEventStruct -> Int32 -> m ()
setKeyEventStructType s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Int32)

data KeyEventStructTypeFieldInfo
instance AttrInfo KeyEventStructTypeFieldInfo where
    type AttrAllowedOps KeyEventStructTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint KeyEventStructTypeFieldInfo = (~) Int32
    type AttrBaseTypeConstraint KeyEventStructTypeFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructTypeFieldInfo = Int32
    type AttrLabel KeyEventStructTypeFieldInfo = "type"
    type AttrOrigin KeyEventStructTypeFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructType
    attrSet _ = setKeyEventStructType
    attrConstruct = undefined
    attrClear _ = undefined

keyEventStruct_type :: AttrLabelProxy "type"
keyEventStruct_type = AttrLabelProxy


getKeyEventStructState :: MonadIO m => KeyEventStruct -> m Word32
getKeyEventStructState s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 4) :: IO Word32
    return val

setKeyEventStructState :: MonadIO m => KeyEventStruct -> Word32 -> m ()
setKeyEventStructState s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 4) (val :: Word32)

data KeyEventStructStateFieldInfo
instance AttrInfo KeyEventStructStateFieldInfo where
    type AttrAllowedOps KeyEventStructStateFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint KeyEventStructStateFieldInfo = (~) Word32
    type AttrBaseTypeConstraint KeyEventStructStateFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructStateFieldInfo = Word32
    type AttrLabel KeyEventStructStateFieldInfo = "state"
    type AttrOrigin KeyEventStructStateFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructState
    attrSet _ = setKeyEventStructState
    attrConstruct = undefined
    attrClear _ = undefined

keyEventStruct_state :: AttrLabelProxy "state"
keyEventStruct_state = AttrLabelProxy


getKeyEventStructKeyval :: MonadIO m => KeyEventStruct -> m Word32
getKeyEventStructKeyval s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO Word32
    return val

setKeyEventStructKeyval :: MonadIO m => KeyEventStruct -> Word32 -> m ()
setKeyEventStructKeyval s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Word32)

data KeyEventStructKeyvalFieldInfo
instance AttrInfo KeyEventStructKeyvalFieldInfo where
    type AttrAllowedOps KeyEventStructKeyvalFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint KeyEventStructKeyvalFieldInfo = (~) Word32
    type AttrBaseTypeConstraint KeyEventStructKeyvalFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructKeyvalFieldInfo = Word32
    type AttrLabel KeyEventStructKeyvalFieldInfo = "keyval"
    type AttrOrigin KeyEventStructKeyvalFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructKeyval
    attrSet _ = setKeyEventStructKeyval
    attrConstruct = undefined
    attrClear _ = undefined

keyEventStruct_keyval :: AttrLabelProxy "keyval"
keyEventStruct_keyval = AttrLabelProxy


getKeyEventStructLength :: MonadIO m => KeyEventStruct -> m Int32
getKeyEventStructLength s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 12) :: IO Int32
    return val

setKeyEventStructLength :: MonadIO m => KeyEventStruct -> Int32 -> m ()
setKeyEventStructLength s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 12) (val :: Int32)

data KeyEventStructLengthFieldInfo
instance AttrInfo KeyEventStructLengthFieldInfo where
    type AttrAllowedOps KeyEventStructLengthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint KeyEventStructLengthFieldInfo = (~) Int32
    type AttrBaseTypeConstraint KeyEventStructLengthFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructLengthFieldInfo = Int32
    type AttrLabel KeyEventStructLengthFieldInfo = "length"
    type AttrOrigin KeyEventStructLengthFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructLength
    attrSet _ = setKeyEventStructLength
    attrConstruct = undefined
    attrClear _ = undefined

keyEventStruct_length :: AttrLabelProxy "length"
keyEventStruct_length = AttrLabelProxy


getKeyEventStructString :: MonadIO m => KeyEventStruct -> m (Maybe T.Text)
getKeyEventStructString 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

setKeyEventStructString :: MonadIO m => KeyEventStruct -> CString -> m ()
setKeyEventStructString s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: CString)

clearKeyEventStructString :: MonadIO m => KeyEventStruct -> m ()
clearKeyEventStructString s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)

data KeyEventStructStringFieldInfo
instance AttrInfo KeyEventStructStringFieldInfo where
    type AttrAllowedOps KeyEventStructStringFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint KeyEventStructStringFieldInfo = (~) CString
    type AttrBaseTypeConstraint KeyEventStructStringFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructStringFieldInfo = Maybe T.Text
    type AttrLabel KeyEventStructStringFieldInfo = "string"
    type AttrOrigin KeyEventStructStringFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructString
    attrSet _ = setKeyEventStructString
    attrConstruct = undefined
    attrClear _ = clearKeyEventStructString

keyEventStruct_string :: AttrLabelProxy "string"
keyEventStruct_string = AttrLabelProxy


getKeyEventStructKeycode :: MonadIO m => KeyEventStruct -> m Word16
getKeyEventStructKeycode s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 24) :: IO Word16
    return val

setKeyEventStructKeycode :: MonadIO m => KeyEventStruct -> Word16 -> m ()
setKeyEventStructKeycode s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 24) (val :: Word16)

data KeyEventStructKeycodeFieldInfo
instance AttrInfo KeyEventStructKeycodeFieldInfo where
    type AttrAllowedOps KeyEventStructKeycodeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint KeyEventStructKeycodeFieldInfo = (~) Word16
    type AttrBaseTypeConstraint KeyEventStructKeycodeFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructKeycodeFieldInfo = Word16
    type AttrLabel KeyEventStructKeycodeFieldInfo = "keycode"
    type AttrOrigin KeyEventStructKeycodeFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructKeycode
    attrSet _ = setKeyEventStructKeycode
    attrConstruct = undefined
    attrClear _ = undefined

keyEventStruct_keycode :: AttrLabelProxy "keycode"
keyEventStruct_keycode = AttrLabelProxy


getKeyEventStructTimestamp :: MonadIO m => KeyEventStruct -> m Word32
getKeyEventStructTimestamp s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 28) :: IO Word32
    return val

setKeyEventStructTimestamp :: MonadIO m => KeyEventStruct -> Word32 -> m ()
setKeyEventStructTimestamp s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 28) (val :: Word32)

data KeyEventStructTimestampFieldInfo
instance AttrInfo KeyEventStructTimestampFieldInfo where
    type AttrAllowedOps KeyEventStructTimestampFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint KeyEventStructTimestampFieldInfo = (~) Word32
    type AttrBaseTypeConstraint KeyEventStructTimestampFieldInfo = (~) KeyEventStruct
    type AttrGetType KeyEventStructTimestampFieldInfo = Word32
    type AttrLabel KeyEventStructTimestampFieldInfo = "timestamp"
    type AttrOrigin KeyEventStructTimestampFieldInfo = KeyEventStruct
    attrGet _ = getKeyEventStructTimestamp
    attrSet _ = setKeyEventStructTimestamp
    attrConstruct = undefined
    attrClear _ = undefined

keyEventStruct_timestamp :: AttrLabelProxy "timestamp"
keyEventStruct_timestamp = AttrLabelProxy



instance O.HasAttributeList KeyEventStruct
type instance O.AttributeList KeyEventStruct = KeyEventStructAttributeList
type KeyEventStructAttributeList = ('[ '("type", KeyEventStructTypeFieldInfo), '("state", KeyEventStructStateFieldInfo), '("keyval", KeyEventStructKeyvalFieldInfo), '("length", KeyEventStructLengthFieldInfo), '("string", KeyEventStructStringFieldInfo), '("keycode", KeyEventStructKeycodeFieldInfo), '("timestamp", KeyEventStructTimestampFieldInfo)] :: [(Symbol, *)])

type family ResolveKeyEventStructMethod (t :: Symbol) (o :: *) :: * where
    ResolveKeyEventStructMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveKeyEventStructMethod t KeyEventStruct, O.MethodInfo info KeyEventStruct p) => O.IsLabelProxy t (KeyEventStruct -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveKeyEventStructMethod t KeyEventStruct, O.MethodInfo info KeyEventStruct p) => O.IsLabel t (KeyEventStruct -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif