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

Describes a change of keyboard focus.
-}

#define ENABLE_OVERLOADING (MIN_VERSION_haskell_gi_overloading(1,0,0) \
       && !defined(__HADDOCK_VERSION__))

module GI.Gdk.Structs.EventFocus
    (

-- * Exported types
    EventFocus(..)                          ,
    newZeroEventFocus                       ,
    noEventFocus                            ,


 -- * Properties
-- ** in #attr:in#
{- | 'True' if the window has gained the keyboard focus, 'False' if
  it has lost the focus.
-}
#if ENABLE_OVERLOADING
    eventFocus_in                           ,
#endif
    getEventFocusIn                         ,
    setEventFocusIn                         ,


-- ** sendEvent #attr:sendEvent#
{- | 'True' if the event was sent explicitly.
-}
#if ENABLE_OVERLOADING
    eventFocus_sendEvent                    ,
#endif
    getEventFocusSendEvent                  ,
    setEventFocusSendEvent                  ,


-- ** type #attr:type#
{- | the type of the event ('GI.Gdk.Enums.EventTypeFocusChange').
-}
#if ENABLE_OVERLOADING
    eventFocus_type                         ,
#endif
    getEventFocusType                       ,
    setEventFocusType                       ,


-- ** window #attr:window#
{- | the window which received the event.
-}
    clearEventFocusWindow                   ,
#if ENABLE_OVERLOADING
    eventFocus_window                       ,
#endif
    getEventFocusWindow                     ,
    setEventFocusWindow                     ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Objects.Window as Gdk.Window

-- | Memory-managed wrapper type.
newtype EventFocus = EventFocus (ManagedPtr EventFocus)
instance WrappedPtr EventFocus where
    wrappedPtrCalloc = callocBytes 24
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 24 >=> wrapPtr EventFocus)
    wrappedPtrFree = Just ptr_to_g_free

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

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


-- | A convenience alias for `Nothing` :: `Maybe` `EventFocus`.
noEventFocus :: Maybe EventFocus
noEventFocus = Nothing

{- |
Get the value of the “@type@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' eventFocus #type
@
-}
getEventFocusType :: MonadIO m => EventFocus -> m Gdk.Enums.EventType
getEventFocusType s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CInt
    let val' = (toEnum . fromIntegral) val
    return val'

{- |
Set the value of the “@type@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' eventFocus [ #type 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventFocusType :: MonadIO m => EventFocus -> Gdk.Enums.EventType -> m ()
setEventFocusType s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = (fromIntegral . fromEnum) val
    poke (ptr `plusPtr` 0) (val' :: CInt)

#if ENABLE_OVERLOADING
data EventFocusTypeFieldInfo
instance AttrInfo EventFocusTypeFieldInfo where
    type AttrAllowedOps EventFocusTypeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventFocusTypeFieldInfo = (~) Gdk.Enums.EventType
    type AttrBaseTypeConstraint EventFocusTypeFieldInfo = (~) EventFocus
    type AttrGetType EventFocusTypeFieldInfo = Gdk.Enums.EventType
    type AttrLabel EventFocusTypeFieldInfo = "type"
    type AttrOrigin EventFocusTypeFieldInfo = EventFocus
    attrGet _ = getEventFocusType
    attrSet _ = setEventFocusType
    attrConstruct = undefined
    attrClear _ = undefined

eventFocus_type :: AttrLabelProxy "type"
eventFocus_type = AttrLabelProxy

#endif


{- |
Get the value of the “@window@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' eventFocus #window
@
-}
getEventFocusWindow :: MonadIO m => EventFocus -> m (Maybe Gdk.Window.Window)
getEventFocusWindow s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO (Ptr Gdk.Window.Window)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newObject Gdk.Window.Window) val'
        return val''
    return result

{- |
Set the value of the “@window@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' eventFocus [ #window 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventFocusWindow :: MonadIO m => EventFocus -> Ptr Gdk.Window.Window -> m ()
setEventFocusWindow s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Ptr Gdk.Window.Window)

{- |
Set the value of the “@window@” field to `Nothing`.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.clear' #window
@
-}
clearEventFocusWindow :: MonadIO m => EventFocus -> m ()
clearEventFocusWindow s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr Gdk.Window.Window)

#if ENABLE_OVERLOADING
data EventFocusWindowFieldInfo
instance AttrInfo EventFocusWindowFieldInfo where
    type AttrAllowedOps EventFocusWindowFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint EventFocusWindowFieldInfo = (~) (Ptr Gdk.Window.Window)
    type AttrBaseTypeConstraint EventFocusWindowFieldInfo = (~) EventFocus
    type AttrGetType EventFocusWindowFieldInfo = Maybe Gdk.Window.Window
    type AttrLabel EventFocusWindowFieldInfo = "window"
    type AttrOrigin EventFocusWindowFieldInfo = EventFocus
    attrGet _ = getEventFocusWindow
    attrSet _ = setEventFocusWindow
    attrConstruct = undefined
    attrClear _ = clearEventFocusWindow

eventFocus_window :: AttrLabelProxy "window"
eventFocus_window = AttrLabelProxy

#endif


{- |
Get the value of the “@send_event@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' eventFocus #sendEvent
@
-}
getEventFocusSendEvent :: MonadIO m => EventFocus -> m Int8
getEventFocusSendEvent s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO Int8
    return val

{- |
Set the value of the “@send_event@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' eventFocus [ #sendEvent 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventFocusSendEvent :: MonadIO m => EventFocus -> Int8 -> m ()
setEventFocusSendEvent s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: Int8)

#if ENABLE_OVERLOADING
data EventFocusSendEventFieldInfo
instance AttrInfo EventFocusSendEventFieldInfo where
    type AttrAllowedOps EventFocusSendEventFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventFocusSendEventFieldInfo = (~) Int8
    type AttrBaseTypeConstraint EventFocusSendEventFieldInfo = (~) EventFocus
    type AttrGetType EventFocusSendEventFieldInfo = Int8
    type AttrLabel EventFocusSendEventFieldInfo = "send_event"
    type AttrOrigin EventFocusSendEventFieldInfo = EventFocus
    attrGet _ = getEventFocusSendEvent
    attrSet _ = setEventFocusSendEvent
    attrConstruct = undefined
    attrClear _ = undefined

eventFocus_sendEvent :: AttrLabelProxy "sendEvent"
eventFocus_sendEvent = AttrLabelProxy

#endif


{- |
Get the value of the “@in@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.get' eventFocus #in
@
-}
getEventFocusIn :: MonadIO m => EventFocus -> m Int16
getEventFocusIn s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 18) :: IO Int16
    return val

{- |
Set the value of the “@in@” field.
When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to

@
'Data.GI.Base.Attributes.set' eventFocus [ #in 'Data.GI.Base.Attributes.:=' value ]
@
-}
setEventFocusIn :: MonadIO m => EventFocus -> Int16 -> m ()
setEventFocusIn s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 18) (val :: Int16)

#if ENABLE_OVERLOADING
data EventFocusInFieldInfo
instance AttrInfo EventFocusInFieldInfo where
    type AttrAllowedOps EventFocusInFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint EventFocusInFieldInfo = (~) Int16
    type AttrBaseTypeConstraint EventFocusInFieldInfo = (~) EventFocus
    type AttrGetType EventFocusInFieldInfo = Int16
    type AttrLabel EventFocusInFieldInfo = "in"
    type AttrOrigin EventFocusInFieldInfo = EventFocus
    attrGet _ = getEventFocusIn
    attrSet _ = setEventFocusIn
    attrConstruct = undefined
    attrClear _ = undefined

eventFocus_in :: AttrLabelProxy "in"
eventFocus_in = AttrLabelProxy

#endif



#if ENABLE_OVERLOADING
instance O.HasAttributeList EventFocus
type instance O.AttributeList EventFocus = EventFocusAttributeList
type EventFocusAttributeList = ('[ '("type", EventFocusTypeFieldInfo), '("window", EventFocusWindowFieldInfo), '("sendEvent", EventFocusSendEventFieldInfo), '("in", EventFocusInFieldInfo)] :: [(Symbol, *)])
#endif

#if ENABLE_OVERLOADING
type family ResolveEventFocusMethod (t :: Symbol) (o :: *) :: * where
    ResolveEventFocusMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveEventFocusMethod t EventFocus, O.MethodInfo info EventFocus p) => OL.IsLabel t (EventFocus -> 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