{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gdk.Objects.Device.Device' object represents a single input device, such
-- as a keyboard, a mouse, a touchpad, etc.
-- 
-- See the t'GI.Gdk.Objects.Seat.Seat' documentation for more information about the
-- various kinds of devices, and their relationships.

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

module GI.Gdk.Objects.Device
    ( 

-- * Exported types
    Device(..)                              ,
    IsDevice                                ,
    toDevice                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasBidiLayouts]("GI.Gdk.Objects.Device#g:method:hasBidiLayouts"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCapsLockState]("GI.Gdk.Objects.Device#g:method:getCapsLockState"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDeviceTool]("GI.Gdk.Objects.Device#g:method:getDeviceTool"), [getDirection]("GI.Gdk.Objects.Device#g:method:getDirection"), [getDisplay]("GI.Gdk.Objects.Device#g:method:getDisplay"), [getHasCursor]("GI.Gdk.Objects.Device#g:method:getHasCursor"), [getModifierState]("GI.Gdk.Objects.Device#g:method:getModifierState"), [getName]("GI.Gdk.Objects.Device#g:method:getName"), [getNumLockState]("GI.Gdk.Objects.Device#g:method:getNumLockState"), [getNumTouches]("GI.Gdk.Objects.Device#g:method:getNumTouches"), [getProductId]("GI.Gdk.Objects.Device#g:method:getProductId"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getScrollLockState]("GI.Gdk.Objects.Device#g:method:getScrollLockState"), [getSeat]("GI.Gdk.Objects.Device#g:method:getSeat"), [getSource]("GI.Gdk.Objects.Device#g:method:getSource"), [getSurfaceAtPosition]("GI.Gdk.Objects.Device#g:method:getSurfaceAtPosition"), [getVendorId]("GI.Gdk.Objects.Device#g:method:getVendorId").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDeviceMethod                     ,
#endif

-- ** getCapsLockState #method:getCapsLockState#

#if defined(ENABLE_OVERLOADING)
    DeviceGetCapsLockStateMethodInfo        ,
#endif
    deviceGetCapsLockState                  ,


-- ** getDeviceTool #method:getDeviceTool#

#if defined(ENABLE_OVERLOADING)
    DeviceGetDeviceToolMethodInfo           ,
#endif
    deviceGetDeviceTool                     ,


-- ** getDirection #method:getDirection#

#if defined(ENABLE_OVERLOADING)
    DeviceGetDirectionMethodInfo            ,
#endif
    deviceGetDirection                      ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    DeviceGetDisplayMethodInfo              ,
#endif
    deviceGetDisplay                        ,


-- ** getHasCursor #method:getHasCursor#

#if defined(ENABLE_OVERLOADING)
    DeviceGetHasCursorMethodInfo            ,
#endif
    deviceGetHasCursor                      ,


-- ** getModifierState #method:getModifierState#

#if defined(ENABLE_OVERLOADING)
    DeviceGetModifierStateMethodInfo        ,
#endif
    deviceGetModifierState                  ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    DeviceGetNameMethodInfo                 ,
#endif
    deviceGetName                           ,


-- ** getNumLockState #method:getNumLockState#

#if defined(ENABLE_OVERLOADING)
    DeviceGetNumLockStateMethodInfo         ,
#endif
    deviceGetNumLockState                   ,


-- ** getNumTouches #method:getNumTouches#

#if defined(ENABLE_OVERLOADING)
    DeviceGetNumTouchesMethodInfo           ,
#endif
    deviceGetNumTouches                     ,


-- ** getProductId #method:getProductId#

#if defined(ENABLE_OVERLOADING)
    DeviceGetProductIdMethodInfo            ,
#endif
    deviceGetProductId                      ,


-- ** getScrollLockState #method:getScrollLockState#

#if defined(ENABLE_OVERLOADING)
    DeviceGetScrollLockStateMethodInfo      ,
#endif
    deviceGetScrollLockState                ,


-- ** getSeat #method:getSeat#

#if defined(ENABLE_OVERLOADING)
    DeviceGetSeatMethodInfo                 ,
#endif
    deviceGetSeat                           ,


-- ** getSource #method:getSource#

#if defined(ENABLE_OVERLOADING)
    DeviceGetSourceMethodInfo               ,
#endif
    deviceGetSource                         ,


-- ** getSurfaceAtPosition #method:getSurfaceAtPosition#

#if defined(ENABLE_OVERLOADING)
    DeviceGetSurfaceAtPositionMethodInfo    ,
#endif
    deviceGetSurfaceAtPosition              ,


-- ** getVendorId #method:getVendorId#

#if defined(ENABLE_OVERLOADING)
    DeviceGetVendorIdMethodInfo             ,
#endif
    deviceGetVendorId                       ,


-- ** hasBidiLayouts #method:hasBidiLayouts#

#if defined(ENABLE_OVERLOADING)
    DeviceHasBidiLayoutsMethodInfo          ,
#endif
    deviceHasBidiLayouts                    ,




 -- * Properties


-- ** capsLockState #attr:capsLockState#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceCapsLockStatePropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceCapsLockState                     ,
#endif
    getDeviceCapsLockState                  ,


-- ** direction #attr:direction#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceDirectionPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceDirection                         ,
#endif
    getDeviceDirection                      ,


-- ** display #attr:display#
-- | The t'GI.Gdk.Objects.Display.Display' the t'GI.Gdk.Objects.Device.Device' pertains to.

#if defined(ENABLE_OVERLOADING)
    DeviceDisplayPropertyInfo               ,
#endif
    constructDeviceDisplay                  ,
#if defined(ENABLE_OVERLOADING)
    deviceDisplay                           ,
#endif
    getDeviceDisplay                        ,


-- ** hasBidiLayouts #attr:hasBidiLayouts#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceHasBidiLayoutsPropertyInfo        ,
#endif
    getDeviceHasBidiLayouts                 ,


-- ** hasCursor #attr:hasCursor#
-- | Whether the device is represented by a cursor on the screen.

#if defined(ENABLE_OVERLOADING)
    DeviceHasCursorPropertyInfo             ,
#endif
    constructDeviceHasCursor                ,
#if defined(ENABLE_OVERLOADING)
    deviceHasCursor                         ,
#endif
    getDeviceHasCursor                      ,


-- ** modifierState #attr:modifierState#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceModifierStatePropertyInfo         ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceModifierState                     ,
#endif
    getDeviceModifierState                  ,


-- ** nAxes #attr:nAxes#
-- | Number of axes in the device.

#if defined(ENABLE_OVERLOADING)
    DeviceNAxesPropertyInfo                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceNAxes                             ,
#endif
    getDeviceNAxes                          ,


-- ** name #attr:name#
-- | The device name.

#if defined(ENABLE_OVERLOADING)
    DeviceNamePropertyInfo                  ,
#endif
    constructDeviceName                     ,
#if defined(ENABLE_OVERLOADING)
    deviceName                              ,
#endif
    getDeviceName                           ,


-- ** numLockState #attr:numLockState#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceNumLockStatePropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceNumLockState                      ,
#endif
    getDeviceNumLockState                   ,


-- ** numTouches #attr:numTouches#
-- | The maximal number of concurrent touches on a touch device.
-- Will be 0 if the device is not a touch device or if the number
-- of touches is unknown.

#if defined(ENABLE_OVERLOADING)
    DeviceNumTouchesPropertyInfo            ,
#endif
    constructDeviceNumTouches               ,
#if defined(ENABLE_OVERLOADING)
    deviceNumTouches                        ,
#endif
    getDeviceNumTouches                     ,


-- ** productId #attr:productId#
-- | Product ID of this device, see 'GI.Gdk.Objects.Device.deviceGetProductId'.

#if defined(ENABLE_OVERLOADING)
    DeviceProductIdPropertyInfo             ,
#endif
    constructDeviceProductId                ,
#if defined(ENABLE_OVERLOADING)
    deviceProductId                         ,
#endif
    getDeviceProductId                      ,


-- ** scrollLockState #attr:scrollLockState#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceScrollLockStatePropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceScrollLockState                   ,
#endif
    getDeviceScrollLockState                ,


-- ** seat #attr:seat#
-- | t'GI.Gdk.Objects.Seat.Seat' of this device.

#if defined(ENABLE_OVERLOADING)
    DeviceSeatPropertyInfo                  ,
#endif
    clearDeviceSeat                         ,
    constructDeviceSeat                     ,
#if defined(ENABLE_OVERLOADING)
    deviceSeat                              ,
#endif
    getDeviceSeat                           ,
    setDeviceSeat                           ,


-- ** source #attr:source#
-- | Source type for the device.

#if defined(ENABLE_OVERLOADING)
    DeviceSourcePropertyInfo                ,
#endif
    constructDeviceSource                   ,
#if defined(ENABLE_OVERLOADING)
    deviceSource                            ,
#endif
    getDeviceSource                         ,


-- ** tool #attr:tool#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    DeviceToolPropertyInfo                  ,
#endif
#if defined(ENABLE_OVERLOADING)
    deviceTool                              ,
#endif
    getDeviceTool                           ,


-- ** vendorId #attr:vendorId#
-- | Vendor ID of this device, see 'GI.Gdk.Objects.Device.deviceGetVendorId'.

#if defined(ENABLE_OVERLOADING)
    DeviceVendorIdPropertyInfo              ,
#endif
    constructDeviceVendorId                 ,
#if defined(ENABLE_OVERLOADING)
    deviceVendorId                          ,
#endif
    getDeviceVendorId                       ,




 -- * Signals


-- ** changed #signal:changed#

    C_DeviceChangedCallback                 ,
    DeviceChangedCallback                   ,
#if defined(ENABLE_OVERLOADING)
    DeviceChangedSignalInfo                 ,
#endif
    afterDeviceChanged                      ,
    genClosure_DeviceChanged                ,
    mk_DeviceChangedCallback                ,
    noDeviceChangedCallback                 ,
    onDeviceChanged                         ,
    wrap_DeviceChangedCallback              ,


-- ** toolChanged #signal:toolChanged#

    C_DeviceToolChangedCallback             ,
    DeviceToolChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    DeviceToolChangedSignalInfo             ,
#endif
    afterDeviceToolChanged                  ,
    genClosure_DeviceToolChanged            ,
    mk_DeviceToolChangedCallback            ,
    noDeviceToolChangedCallback             ,
    onDeviceToolChanged                     ,
    wrap_DeviceToolChangedCallback          ,




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
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.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
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 qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Objects.DeviceTool as Gdk.DeviceTool
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Seat as Gdk.Seat
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Pango.Enums as Pango.Enums

-- | Memory-managed wrapper type.
newtype Device = Device (SP.ManagedPtr Device)
    deriving (Device -> Device -> Bool
(Device -> Device -> Bool)
-> (Device -> Device -> Bool) -> Eq Device
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Device -> Device -> Bool
$c/= :: Device -> Device -> Bool
== :: Device -> Device -> Bool
$c== :: Device -> Device -> Bool
Eq)

instance SP.ManagedPtrNewtype Device where
    toManagedPtr :: Device -> ManagedPtr Device
toManagedPtr (Device ManagedPtr Device
p) = ManagedPtr Device
p

foreign import ccall "gdk_device_get_type"
    c_gdk_device_get_type :: IO B.Types.GType

instance B.Types.TypedObject Device where
    glibType :: IO GType
glibType = IO GType
c_gdk_device_get_type

instance B.Types.GObject Device

-- | Type class for types which can be safely cast to `Device`, for instance with `toDevice`.
class (SP.GObject o, O.IsDescendantOf Device o) => IsDevice o
instance (SP.GObject o, O.IsDescendantOf Device o) => IsDevice o

instance O.HasParentTypes Device
type instance O.ParentTypes Device = '[GObject.Object.Object]

-- | Cast to `Device`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toDevice :: (MIO.MonadIO m, IsDevice o) => o -> m Device
toDevice :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Device
toDevice = IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Device -> m Device) -> (o -> IO Device) -> o -> m Device
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Device -> Device) -> o -> IO Device
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Device -> Device
Device

-- | Convert 'Device' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Device) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_device_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Device -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Device
P.Nothing = Ptr GValue -> Ptr Device -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Device
forall a. Ptr a
FP.nullPtr :: FP.Ptr Device)
    gvalueSet_ Ptr GValue
gv (P.Just Device
obj) = Device -> (Ptr Device -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Device
obj (Ptr GValue -> Ptr Device -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Device)
gvalueGet_ Ptr GValue
gv = do
        Ptr Device
ptr <- Ptr GValue -> IO (Ptr Device)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Device)
        if Ptr Device
ptr Ptr Device -> Ptr Device -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Device
forall a. Ptr a
FP.nullPtr
        then Device -> Maybe Device
forall a. a -> Maybe a
P.Just (Device -> Maybe Device) -> IO Device -> IO (Maybe Device)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Device -> Device
Device Ptr Device
ptr
        else Maybe Device -> IO (Maybe Device)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Device
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveDeviceMethod (t :: Symbol) (o :: *) :: * where
    ResolveDeviceMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDeviceMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDeviceMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDeviceMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDeviceMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDeviceMethod "hasBidiLayouts" o = DeviceHasBidiLayoutsMethodInfo
    ResolveDeviceMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDeviceMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDeviceMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDeviceMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDeviceMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDeviceMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDeviceMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDeviceMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDeviceMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDeviceMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDeviceMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDeviceMethod "getCapsLockState" o = DeviceGetCapsLockStateMethodInfo
    ResolveDeviceMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDeviceMethod "getDeviceTool" o = DeviceGetDeviceToolMethodInfo
    ResolveDeviceMethod "getDirection" o = DeviceGetDirectionMethodInfo
    ResolveDeviceMethod "getDisplay" o = DeviceGetDisplayMethodInfo
    ResolveDeviceMethod "getHasCursor" o = DeviceGetHasCursorMethodInfo
    ResolveDeviceMethod "getModifierState" o = DeviceGetModifierStateMethodInfo
    ResolveDeviceMethod "getName" o = DeviceGetNameMethodInfo
    ResolveDeviceMethod "getNumLockState" o = DeviceGetNumLockStateMethodInfo
    ResolveDeviceMethod "getNumTouches" o = DeviceGetNumTouchesMethodInfo
    ResolveDeviceMethod "getProductId" o = DeviceGetProductIdMethodInfo
    ResolveDeviceMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDeviceMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDeviceMethod "getScrollLockState" o = DeviceGetScrollLockStateMethodInfo
    ResolveDeviceMethod "getSeat" o = DeviceGetSeatMethodInfo
    ResolveDeviceMethod "getSource" o = DeviceGetSourceMethodInfo
    ResolveDeviceMethod "getSurfaceAtPosition" o = DeviceGetSurfaceAtPositionMethodInfo
    ResolveDeviceMethod "getVendorId" o = DeviceGetVendorIdMethodInfo
    ResolveDeviceMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDeviceMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDeviceMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDeviceMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDeviceMethod t Device, O.OverloadedMethod info Device p) => OL.IsLabel t (Device -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveDeviceMethod t Device, O.OverloadedMethod info Device p, R.HasField t Device p) => R.HasField t Device p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveDeviceMethod t Device, O.OverloadedMethodInfo info Device) => OL.IsLabel t (O.MethodProxy info Device) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal Device::changed
-- | The [changed](#g:signal:changed) signal is emitted either when the t'GI.Gdk.Objects.Device.Device'
-- has changed the number of either axes or keys. For example
-- on X11 this will normally happen when the physical device
-- routing events through the logical device changes (for
-- example, user switches from the USB mouse to a tablet); in
-- that case the logical device will change to reflect the axes
-- and keys on the new physical device.
type DeviceChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DeviceChangedCallback`@.
noDeviceChangedCallback :: Maybe DeviceChangedCallback
noDeviceChangedCallback :: Maybe (IO ())
noDeviceChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DeviceChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DeviceChangedCallback`.
foreign import ccall "wrapper"
    mk_DeviceChangedCallback :: C_DeviceChangedCallback -> IO (FunPtr C_DeviceChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DeviceChanged :: MonadIO m => DeviceChangedCallback -> m (GClosure C_DeviceChangedCallback)
genClosure_DeviceChanged :: forall (m :: * -> *).
MonadIO m =>
IO () -> m (GClosure C_DeviceChangedCallback)
genClosure_DeviceChanged IO ()
cb = IO (GClosure C_DeviceChangedCallback)
-> m (GClosure C_DeviceChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DeviceChangedCallback)
 -> m (GClosure C_DeviceChangedCallback))
-> IO (GClosure C_DeviceChangedCallback)
-> m (GClosure C_DeviceChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DeviceChangedCallback
cb' = IO () -> C_DeviceChangedCallback
wrap_DeviceChangedCallback IO ()
cb
    C_DeviceChangedCallback -> IO (FunPtr C_DeviceChangedCallback)
mk_DeviceChangedCallback C_DeviceChangedCallback
cb' IO (FunPtr C_DeviceChangedCallback)
-> (FunPtr C_DeviceChangedCallback
    -> IO (GClosure C_DeviceChangedCallback))
-> IO (GClosure C_DeviceChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DeviceChangedCallback
-> IO (GClosure C_DeviceChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DeviceChangedCallback` into a `C_DeviceChangedCallback`.
wrap_DeviceChangedCallback ::
    DeviceChangedCallback ->
    C_DeviceChangedCallback
wrap_DeviceChangedCallback :: IO () -> C_DeviceChangedCallback
wrap_DeviceChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' device #changed callback
-- @
-- 
-- 
onDeviceChanged :: (IsDevice a, MonadIO m) => a -> DeviceChangedCallback -> m SignalHandlerId
onDeviceChanged :: forall a (m :: * -> *).
(IsDevice a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onDeviceChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DeviceChangedCallback
cb' = IO () -> C_DeviceChangedCallback
wrap_DeviceChangedCallback IO ()
cb
    FunPtr C_DeviceChangedCallback
cb'' <- C_DeviceChangedCallback -> IO (FunPtr C_DeviceChangedCallback)
mk_DeviceChangedCallback C_DeviceChangedCallback
cb'
    a
-> Text
-> FunPtr C_DeviceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_DeviceChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' device #changed callback
-- @
-- 
-- 
afterDeviceChanged :: (IsDevice a, MonadIO m) => a -> DeviceChangedCallback -> m SignalHandlerId
afterDeviceChanged :: forall a (m :: * -> *).
(IsDevice a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
afterDeviceChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DeviceChangedCallback
cb' = IO () -> C_DeviceChangedCallback
wrap_DeviceChangedCallback IO ()
cb
    FunPtr C_DeviceChangedCallback
cb'' <- C_DeviceChangedCallback -> IO (FunPtr C_DeviceChangedCallback)
mk_DeviceChangedCallback C_DeviceChangedCallback
cb'
    a
-> Text
-> FunPtr C_DeviceChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_DeviceChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DeviceChangedSignalInfo
instance SignalInfo DeviceChangedSignalInfo where
    type HaskellCallbackType DeviceChangedSignalInfo = DeviceChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DeviceChangedCallback cb
        cb'' <- mk_DeviceChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- signal Device::tool-changed
-- | The [toolChanged](#g:signal:toolChanged) signal is emitted on pen\/eraser
-- @/GdkDevices/@ whenever tools enter or leave proximity.
type DeviceToolChangedCallback =
    Gdk.DeviceTool.DeviceTool
    -- ^ /@tool@/: The new current tool
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DeviceToolChangedCallback`@.
noDeviceToolChangedCallback :: Maybe DeviceToolChangedCallback
noDeviceToolChangedCallback :: Maybe DeviceToolChangedCallback
noDeviceToolChangedCallback = Maybe DeviceToolChangedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_DeviceToolChangedCallback =
    Ptr () ->                               -- object
    Ptr Gdk.DeviceTool.DeviceTool ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DeviceToolChangedCallback`.
foreign import ccall "wrapper"
    mk_DeviceToolChangedCallback :: C_DeviceToolChangedCallback -> IO (FunPtr C_DeviceToolChangedCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_DeviceToolChanged :: MonadIO m => DeviceToolChangedCallback -> m (GClosure C_DeviceToolChangedCallback)
genClosure_DeviceToolChanged :: forall (m :: * -> *).
MonadIO m =>
DeviceToolChangedCallback
-> m (GClosure C_DeviceToolChangedCallback)
genClosure_DeviceToolChanged DeviceToolChangedCallback
cb = IO (GClosure C_DeviceToolChangedCallback)
-> m (GClosure C_DeviceToolChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DeviceToolChangedCallback)
 -> m (GClosure C_DeviceToolChangedCallback))
-> IO (GClosure C_DeviceToolChangedCallback)
-> m (GClosure C_DeviceToolChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DeviceToolChangedCallback
cb' = DeviceToolChangedCallback -> C_DeviceToolChangedCallback
wrap_DeviceToolChangedCallback DeviceToolChangedCallback
cb
    C_DeviceToolChangedCallback
-> IO (FunPtr C_DeviceToolChangedCallback)
mk_DeviceToolChangedCallback C_DeviceToolChangedCallback
cb' IO (FunPtr C_DeviceToolChangedCallback)
-> (FunPtr C_DeviceToolChangedCallback
    -> IO (GClosure C_DeviceToolChangedCallback))
-> IO (GClosure C_DeviceToolChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DeviceToolChangedCallback
-> IO (GClosure C_DeviceToolChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DeviceToolChangedCallback` into a `C_DeviceToolChangedCallback`.
wrap_DeviceToolChangedCallback ::
    DeviceToolChangedCallback ->
    C_DeviceToolChangedCallback
wrap_DeviceToolChangedCallback :: DeviceToolChangedCallback -> C_DeviceToolChangedCallback
wrap_DeviceToolChangedCallback DeviceToolChangedCallback
_cb Ptr ()
_ Ptr DeviceTool
tool Ptr ()
_ = do
    DeviceTool
tool' <- ((ManagedPtr DeviceTool -> DeviceTool)
-> Ptr DeviceTool -> IO DeviceTool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DeviceTool -> DeviceTool
Gdk.DeviceTool.DeviceTool) Ptr DeviceTool
tool
    DeviceToolChangedCallback
_cb  DeviceTool
tool'


-- | Connect a signal handler for the [toolChanged](#signal:toolChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' device #toolChanged callback
-- @
-- 
-- 
onDeviceToolChanged :: (IsDevice a, MonadIO m) => a -> DeviceToolChangedCallback -> m SignalHandlerId
onDeviceToolChanged :: forall a (m :: * -> *).
(IsDevice a, MonadIO m) =>
a -> DeviceToolChangedCallback -> m SignalHandlerId
onDeviceToolChanged a
obj DeviceToolChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DeviceToolChangedCallback
cb' = DeviceToolChangedCallback -> C_DeviceToolChangedCallback
wrap_DeviceToolChangedCallback DeviceToolChangedCallback
cb
    FunPtr C_DeviceToolChangedCallback
cb'' <- C_DeviceToolChangedCallback
-> IO (FunPtr C_DeviceToolChangedCallback)
mk_DeviceToolChangedCallback C_DeviceToolChangedCallback
cb'
    a
-> Text
-> FunPtr C_DeviceToolChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"tool-changed" FunPtr C_DeviceToolChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [toolChanged](#signal:toolChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' device #toolChanged callback
-- @
-- 
-- 
afterDeviceToolChanged :: (IsDevice a, MonadIO m) => a -> DeviceToolChangedCallback -> m SignalHandlerId
afterDeviceToolChanged :: forall a (m :: * -> *).
(IsDevice a, MonadIO m) =>
a -> DeviceToolChangedCallback -> m SignalHandlerId
afterDeviceToolChanged a
obj DeviceToolChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DeviceToolChangedCallback
cb' = DeviceToolChangedCallback -> C_DeviceToolChangedCallback
wrap_DeviceToolChangedCallback DeviceToolChangedCallback
cb
    FunPtr C_DeviceToolChangedCallback
cb'' <- C_DeviceToolChangedCallback
-> IO (FunPtr C_DeviceToolChangedCallback)
mk_DeviceToolChangedCallback C_DeviceToolChangedCallback
cb'
    a
-> Text
-> FunPtr C_DeviceToolChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"tool-changed" FunPtr C_DeviceToolChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DeviceToolChangedSignalInfo
instance SignalInfo DeviceToolChangedSignalInfo where
    type HaskellCallbackType DeviceToolChangedSignalInfo = DeviceToolChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DeviceToolChangedCallback cb
        cb'' <- mk_DeviceToolChangedCallback cb'
        connectSignalFunPtr obj "tool-changed" cb'' connectMode detail

#endif

-- VVV Prop "caps-lock-state"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@caps-lock-state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #capsLockState
-- @
getDeviceCapsLockState :: (MonadIO m, IsDevice o) => o -> m Bool
getDeviceCapsLockState :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Bool
getDeviceCapsLockState o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"caps-lock-state"

#if defined(ENABLE_OVERLOADING)
data DeviceCapsLockStatePropertyInfo
instance AttrInfo DeviceCapsLockStatePropertyInfo where
    type AttrAllowedOps DeviceCapsLockStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceCapsLockStatePropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceCapsLockStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceCapsLockStatePropertyInfo = (~) ()
    type AttrTransferType DeviceCapsLockStatePropertyInfo = ()
    type AttrGetType DeviceCapsLockStatePropertyInfo = Bool
    type AttrLabel DeviceCapsLockStatePropertyInfo = "caps-lock-state"
    type AttrOrigin DeviceCapsLockStatePropertyInfo = Device
    attrGet = getDeviceCapsLockState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "direction"
   -- Type: TInterface (Name {namespace = "Pango", name = "Direction"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@direction@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #direction
-- @
getDeviceDirection :: (MonadIO m, IsDevice o) => o -> m Pango.Enums.Direction
getDeviceDirection :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Direction
getDeviceDirection o
obj = IO Direction -> m Direction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Direction -> m Direction) -> IO Direction -> m Direction
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Direction
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"direction"

#if defined(ENABLE_OVERLOADING)
data DeviceDirectionPropertyInfo
instance AttrInfo DeviceDirectionPropertyInfo where
    type AttrAllowedOps DeviceDirectionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceDirectionPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceDirectionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceDirectionPropertyInfo = (~) ()
    type AttrTransferType DeviceDirectionPropertyInfo = ()
    type AttrGetType DeviceDirectionPropertyInfo = Pango.Enums.Direction
    type AttrLabel DeviceDirectionPropertyInfo = "direction"
    type AttrOrigin DeviceDirectionPropertyInfo = Device
    attrGet = getDeviceDirection
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "display"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Display"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@display@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #display
-- @
getDeviceDisplay :: (MonadIO m, IsDevice o) => o -> m Gdk.Display.Display
getDeviceDisplay :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Display
getDeviceDisplay o
obj = IO Display -> m Display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Display -> m Display) -> IO Display -> m Display
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Display) -> IO Display
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDeviceDisplay" (IO (Maybe Display) -> IO Display)
-> IO (Maybe Display) -> IO Display
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Display -> Display) -> IO (Maybe Display)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"display" ManagedPtr Display -> Display
Gdk.Display.Display

-- | Construct a `GValueConstruct` with valid value for the “@display@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceDisplay :: (IsDevice o, MIO.MonadIO m, Gdk.Display.IsDisplay a) => a -> m (GValueConstruct o)
constructDeviceDisplay :: forall o (m :: * -> *) a.
(IsDevice o, MonadIO m, IsDisplay a) =>
a -> m (GValueConstruct o)
constructDeviceDisplay a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"display" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data DeviceDisplayPropertyInfo
instance AttrInfo DeviceDisplayPropertyInfo where
    type AttrAllowedOps DeviceDisplayPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceDisplayPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferTypeConstraint DeviceDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferType DeviceDisplayPropertyInfo = Gdk.Display.Display
    type AttrGetType DeviceDisplayPropertyInfo = Gdk.Display.Display
    type AttrLabel DeviceDisplayPropertyInfo = "display"
    type AttrOrigin DeviceDisplayPropertyInfo = Device
    attrGet = getDeviceDisplay
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Display.Display v
    attrConstruct = constructDeviceDisplay
    attrClear = undefined
#endif

-- VVV Prop "has-bidi-layouts"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@has-bidi-layouts@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #hasBidiLayouts
-- @
getDeviceHasBidiLayouts :: (MonadIO m, IsDevice o) => o -> m Bool
getDeviceHasBidiLayouts :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Bool
getDeviceHasBidiLayouts o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"has-bidi-layouts"

#if defined(ENABLE_OVERLOADING)
data DeviceHasBidiLayoutsPropertyInfo
instance AttrInfo DeviceHasBidiLayoutsPropertyInfo where
    type AttrAllowedOps DeviceHasBidiLayoutsPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceHasBidiLayoutsPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceHasBidiLayoutsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceHasBidiLayoutsPropertyInfo = (~) ()
    type AttrTransferType DeviceHasBidiLayoutsPropertyInfo = ()
    type AttrGetType DeviceHasBidiLayoutsPropertyInfo = Bool
    type AttrLabel DeviceHasBidiLayoutsPropertyInfo = "has-bidi-layouts"
    type AttrOrigin DeviceHasBidiLayoutsPropertyInfo = Device
    attrGet = getDeviceHasBidiLayouts
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "has-cursor"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@has-cursor@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #hasCursor
-- @
getDeviceHasCursor :: (MonadIO m, IsDevice o) => o -> m Bool
getDeviceHasCursor :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Bool
getDeviceHasCursor o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"has-cursor"

-- | Construct a `GValueConstruct` with valid value for the “@has-cursor@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceHasCursor :: (IsDevice o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructDeviceHasCursor :: forall o (m :: * -> *).
(IsDevice o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructDeviceHasCursor Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"has-cursor" Bool
val

#if defined(ENABLE_OVERLOADING)
data DeviceHasCursorPropertyInfo
instance AttrInfo DeviceHasCursorPropertyInfo where
    type AttrAllowedOps DeviceHasCursorPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DeviceHasCursorPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceHasCursorPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint DeviceHasCursorPropertyInfo = (~) Bool
    type AttrTransferType DeviceHasCursorPropertyInfo = Bool
    type AttrGetType DeviceHasCursorPropertyInfo = Bool
    type AttrLabel DeviceHasCursorPropertyInfo = "has-cursor"
    type AttrOrigin DeviceHasCursorPropertyInfo = Device
    attrGet = getDeviceHasCursor
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeviceHasCursor
    attrClear = undefined
#endif

-- VVV Prop "modifier-state"
   -- Type: TInterface (Name {namespace = "Gdk", name = "ModifierType"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@modifier-state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #modifierState
-- @
getDeviceModifierState :: (MonadIO m, IsDevice o) => o -> m [Gdk.Flags.ModifierType]
getDeviceModifierState :: forall (m :: * -> *) o.
(MonadIO m, IsDevice o) =>
o -> m [ModifierType]
getDeviceModifierState o
obj = IO [ModifierType] -> m [ModifierType]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [ModifierType] -> m [ModifierType])
-> IO [ModifierType] -> m [ModifierType]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [ModifierType]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"modifier-state"

#if defined(ENABLE_OVERLOADING)
data DeviceModifierStatePropertyInfo
instance AttrInfo DeviceModifierStatePropertyInfo where
    type AttrAllowedOps DeviceModifierStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceModifierStatePropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceModifierStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceModifierStatePropertyInfo = (~) ()
    type AttrTransferType DeviceModifierStatePropertyInfo = ()
    type AttrGetType DeviceModifierStatePropertyInfo = [Gdk.Flags.ModifierType]
    type AttrLabel DeviceModifierStatePropertyInfo = "modifier-state"
    type AttrOrigin DeviceModifierStatePropertyInfo = Device
    attrGet = getDeviceModifierState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "n-axes"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@n-axes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #nAxes
-- @
getDeviceNAxes :: (MonadIO m, IsDevice o) => o -> m Word32
getDeviceNAxes :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Word32
getDeviceNAxes o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"n-axes"

#if defined(ENABLE_OVERLOADING)
data DeviceNAxesPropertyInfo
instance AttrInfo DeviceNAxesPropertyInfo where
    type AttrAllowedOps DeviceNAxesPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceNAxesPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceNAxesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceNAxesPropertyInfo = (~) ()
    type AttrTransferType DeviceNAxesPropertyInfo = ()
    type AttrGetType DeviceNAxesPropertyInfo = Word32
    type AttrLabel DeviceNAxesPropertyInfo = "n-axes"
    type AttrOrigin DeviceNAxesPropertyInfo = Device
    attrGet = getDeviceNAxes
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #name
-- @
getDeviceName :: (MonadIO m, IsDevice o) => o -> m T.Text
getDeviceName :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Text
getDeviceName o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDeviceName" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"name"

-- | Construct a `GValueConstruct` with valid value for the “@name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceName :: (IsDevice o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDeviceName :: forall o (m :: * -> *).
(IsDevice o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDeviceName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DeviceNamePropertyInfo
instance AttrInfo DeviceNamePropertyInfo where
    type AttrAllowedOps DeviceNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceNamePropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DeviceNamePropertyInfo = (~) T.Text
    type AttrTransferType DeviceNamePropertyInfo = T.Text
    type AttrGetType DeviceNamePropertyInfo = T.Text
    type AttrLabel DeviceNamePropertyInfo = "name"
    type AttrOrigin DeviceNamePropertyInfo = Device
    attrGet = getDeviceName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeviceName
    attrClear = undefined
#endif

-- VVV Prop "num-lock-state"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@num-lock-state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #numLockState
-- @
getDeviceNumLockState :: (MonadIO m, IsDevice o) => o -> m Bool
getDeviceNumLockState :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Bool
getDeviceNumLockState o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"num-lock-state"

#if defined(ENABLE_OVERLOADING)
data DeviceNumLockStatePropertyInfo
instance AttrInfo DeviceNumLockStatePropertyInfo where
    type AttrAllowedOps DeviceNumLockStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceNumLockStatePropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceNumLockStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceNumLockStatePropertyInfo = (~) ()
    type AttrTransferType DeviceNumLockStatePropertyInfo = ()
    type AttrGetType DeviceNumLockStatePropertyInfo = Bool
    type AttrLabel DeviceNumLockStatePropertyInfo = "num-lock-state"
    type AttrOrigin DeviceNumLockStatePropertyInfo = Device
    attrGet = getDeviceNumLockState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "num-touches"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@num-touches@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #numTouches
-- @
getDeviceNumTouches :: (MonadIO m, IsDevice o) => o -> m Word32
getDeviceNumTouches :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Word32
getDeviceNumTouches o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"num-touches"

-- | Construct a `GValueConstruct` with valid value for the “@num-touches@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceNumTouches :: (IsDevice o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructDeviceNumTouches :: forall o (m :: * -> *).
(IsDevice o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructDeviceNumTouches Word32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"num-touches" Word32
val

#if defined(ENABLE_OVERLOADING)
data DeviceNumTouchesPropertyInfo
instance AttrInfo DeviceNumTouchesPropertyInfo where
    type AttrAllowedOps DeviceNumTouchesPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DeviceNumTouchesPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceNumTouchesPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint DeviceNumTouchesPropertyInfo = (~) Word32
    type AttrTransferType DeviceNumTouchesPropertyInfo = Word32
    type AttrGetType DeviceNumTouchesPropertyInfo = Word32
    type AttrLabel DeviceNumTouchesPropertyInfo = "num-touches"
    type AttrOrigin DeviceNumTouchesPropertyInfo = Device
    attrGet = getDeviceNumTouches
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeviceNumTouches
    attrClear = undefined
#endif

-- VVV Prop "product-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@product-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #productId
-- @
getDeviceProductId :: (MonadIO m, IsDevice o) => o -> m (Maybe T.Text)
getDeviceProductId :: forall (m :: * -> *) o.
(MonadIO m, IsDevice o) =>
o -> m (Maybe Text)
getDeviceProductId o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"product-id"

-- | Construct a `GValueConstruct` with valid value for the “@product-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceProductId :: (IsDevice o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDeviceProductId :: forall o (m :: * -> *).
(IsDevice o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDeviceProductId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"product-id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DeviceProductIdPropertyInfo
instance AttrInfo DeviceProductIdPropertyInfo where
    type AttrAllowedOps DeviceProductIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceProductIdPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceProductIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DeviceProductIdPropertyInfo = (~) T.Text
    type AttrTransferType DeviceProductIdPropertyInfo = T.Text
    type AttrGetType DeviceProductIdPropertyInfo = (Maybe T.Text)
    type AttrLabel DeviceProductIdPropertyInfo = "product-id"
    type AttrOrigin DeviceProductIdPropertyInfo = Device
    attrGet = getDeviceProductId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeviceProductId
    attrClear = undefined
#endif

-- VVV Prop "scroll-lock-state"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@scroll-lock-state@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #scrollLockState
-- @
getDeviceScrollLockState :: (MonadIO m, IsDevice o) => o -> m Bool
getDeviceScrollLockState :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Bool
getDeviceScrollLockState o
obj = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"scroll-lock-state"

#if defined(ENABLE_OVERLOADING)
data DeviceScrollLockStatePropertyInfo
instance AttrInfo DeviceScrollLockStatePropertyInfo where
    type AttrAllowedOps DeviceScrollLockStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DeviceScrollLockStatePropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceScrollLockStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceScrollLockStatePropertyInfo = (~) ()
    type AttrTransferType DeviceScrollLockStatePropertyInfo = ()
    type AttrGetType DeviceScrollLockStatePropertyInfo = Bool
    type AttrLabel DeviceScrollLockStatePropertyInfo = "scroll-lock-state"
    type AttrOrigin DeviceScrollLockStatePropertyInfo = Device
    attrGet = getDeviceScrollLockState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "seat"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Seat"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@seat@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #seat
-- @
getDeviceSeat :: (MonadIO m, IsDevice o) => o -> m Gdk.Seat.Seat
getDeviceSeat :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m Seat
getDeviceSeat o
obj = IO Seat -> m Seat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Seat -> m Seat) -> IO Seat -> m Seat
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Seat) -> IO Seat
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getDeviceSeat" (IO (Maybe Seat) -> IO Seat) -> IO (Maybe Seat) -> IO Seat
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Seat -> Seat) -> IO (Maybe Seat)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"seat" ManagedPtr Seat -> Seat
Gdk.Seat.Seat

-- | Set the value of the “@seat@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' device [ #seat 'Data.GI.Base.Attributes.:=' value ]
-- @
setDeviceSeat :: (MonadIO m, IsDevice o, Gdk.Seat.IsSeat a) => o -> a -> m ()
setDeviceSeat :: forall (m :: * -> *) o a.
(MonadIO m, IsDevice o, IsSeat a) =>
o -> a -> m ()
setDeviceSeat o
obj a
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"seat" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@seat@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceSeat :: (IsDevice o, MIO.MonadIO m, Gdk.Seat.IsSeat a) => a -> m (GValueConstruct o)
constructDeviceSeat :: forall o (m :: * -> *) a.
(IsDevice o, MonadIO m, IsSeat a) =>
a -> m (GValueConstruct o)
constructDeviceSeat a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"seat" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@seat@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #seat
-- @
clearDeviceSeat :: (MonadIO m, IsDevice o) => o -> m ()
clearDeviceSeat :: forall (m :: * -> *) o. (MonadIO m, IsDevice o) => o -> m ()
clearDeviceSeat o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Seat -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"seat" (Maybe Seat
forall a. Maybe a
Nothing :: Maybe Gdk.Seat.Seat)

#if defined(ENABLE_OVERLOADING)
data DeviceSeatPropertyInfo
instance AttrInfo DeviceSeatPropertyInfo where
    type AttrAllowedOps DeviceSeatPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceSeatPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceSeatPropertyInfo = Gdk.Seat.IsSeat
    type AttrTransferTypeConstraint DeviceSeatPropertyInfo = Gdk.Seat.IsSeat
    type AttrTransferType DeviceSeatPropertyInfo = Gdk.Seat.Seat
    type AttrGetType DeviceSeatPropertyInfo = Gdk.Seat.Seat
    type AttrLabel DeviceSeatPropertyInfo = "seat"
    type AttrOrigin DeviceSeatPropertyInfo = Device
    attrGet = getDeviceSeat
    attrSet = setDeviceSeat
    attrTransfer _ v = do
        unsafeCastTo Gdk.Seat.Seat v
    attrConstruct = constructDeviceSeat
    attrClear = clearDeviceSeat
#endif

-- VVV Prop "source"
   -- Type: TInterface (Name {namespace = "Gdk", name = "InputSource"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@source@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #source
-- @
getDeviceSource :: (MonadIO m, IsDevice o) => o -> m Gdk.Enums.InputSource
getDeviceSource :: forall (m :: * -> *) o.
(MonadIO m, IsDevice o) =>
o -> m InputSource
getDeviceSource o
obj = IO InputSource -> m InputSource
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InputSource -> m InputSource)
-> IO InputSource -> m InputSource
forall a b. (a -> b) -> a -> b
$ o -> String -> IO InputSource
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"source"

-- | Construct a `GValueConstruct` with valid value for the “@source@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceSource :: (IsDevice o, MIO.MonadIO m) => Gdk.Enums.InputSource -> m (GValueConstruct o)
constructDeviceSource :: forall o (m :: * -> *).
(IsDevice o, MonadIO m) =>
InputSource -> m (GValueConstruct o)
constructDeviceSource InputSource
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> InputSource -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"source" InputSource
val

#if defined(ENABLE_OVERLOADING)
data DeviceSourcePropertyInfo
instance AttrInfo DeviceSourcePropertyInfo where
    type AttrAllowedOps DeviceSourcePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DeviceSourcePropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceSourcePropertyInfo = (~) Gdk.Enums.InputSource
    type AttrTransferTypeConstraint DeviceSourcePropertyInfo = (~) Gdk.Enums.InputSource
    type AttrTransferType DeviceSourcePropertyInfo = Gdk.Enums.InputSource
    type AttrGetType DeviceSourcePropertyInfo = Gdk.Enums.InputSource
    type AttrLabel DeviceSourcePropertyInfo = "source"
    type AttrOrigin DeviceSourcePropertyInfo = Device
    attrGet = getDeviceSource
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeviceSource
    attrClear = undefined
#endif

-- VVV Prop "tool"
   -- Type: TInterface (Name {namespace = "Gdk", name = "DeviceTool"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@tool@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #tool
-- @
getDeviceTool :: (MonadIO m, IsDevice o) => o -> m (Maybe Gdk.DeviceTool.DeviceTool)
getDeviceTool :: forall (m :: * -> *) o.
(MonadIO m, IsDevice o) =>
o -> m (Maybe DeviceTool)
getDeviceTool o
obj = IO (Maybe DeviceTool) -> m (Maybe DeviceTool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe DeviceTool) -> m (Maybe DeviceTool))
-> IO (Maybe DeviceTool) -> m (Maybe DeviceTool)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr DeviceTool -> DeviceTool)
-> IO (Maybe DeviceTool)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"tool" ManagedPtr DeviceTool -> DeviceTool
Gdk.DeviceTool.DeviceTool

#if defined(ENABLE_OVERLOADING)
data DeviceToolPropertyInfo
instance AttrInfo DeviceToolPropertyInfo where
    type AttrAllowedOps DeviceToolPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceToolPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceToolPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DeviceToolPropertyInfo = (~) ()
    type AttrTransferType DeviceToolPropertyInfo = ()
    type AttrGetType DeviceToolPropertyInfo = (Maybe Gdk.DeviceTool.DeviceTool)
    type AttrLabel DeviceToolPropertyInfo = "tool"
    type AttrOrigin DeviceToolPropertyInfo = Device
    attrGet = getDeviceTool
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "vendor-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just True,Nothing)

-- | Get the value of the “@vendor-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' device #vendorId
-- @
getDeviceVendorId :: (MonadIO m, IsDevice o) => o -> m (Maybe T.Text)
getDeviceVendorId :: forall (m :: * -> *) o.
(MonadIO m, IsDevice o) =>
o -> m (Maybe Text)
getDeviceVendorId o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"vendor-id"

-- | Construct a `GValueConstruct` with valid value for the “@vendor-id@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDeviceVendorId :: (IsDevice o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructDeviceVendorId :: forall o (m :: * -> *).
(IsDevice o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructDeviceVendorId Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"vendor-id" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data DeviceVendorIdPropertyInfo
instance AttrInfo DeviceVendorIdPropertyInfo where
    type AttrAllowedOps DeviceVendorIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DeviceVendorIdPropertyInfo = IsDevice
    type AttrSetTypeConstraint DeviceVendorIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint DeviceVendorIdPropertyInfo = (~) T.Text
    type AttrTransferType DeviceVendorIdPropertyInfo = T.Text
    type AttrGetType DeviceVendorIdPropertyInfo = (Maybe T.Text)
    type AttrLabel DeviceVendorIdPropertyInfo = "vendor-id"
    type AttrOrigin DeviceVendorIdPropertyInfo = Device
    attrGet = getDeviceVendorId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDeviceVendorId
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Device
type instance O.AttributeList Device = DeviceAttributeList
type DeviceAttributeList = ('[ '("capsLockState", DeviceCapsLockStatePropertyInfo), '("direction", DeviceDirectionPropertyInfo), '("display", DeviceDisplayPropertyInfo), '("hasBidiLayouts", DeviceHasBidiLayoutsPropertyInfo), '("hasCursor", DeviceHasCursorPropertyInfo), '("modifierState", DeviceModifierStatePropertyInfo), '("nAxes", DeviceNAxesPropertyInfo), '("name", DeviceNamePropertyInfo), '("numLockState", DeviceNumLockStatePropertyInfo), '("numTouches", DeviceNumTouchesPropertyInfo), '("productId", DeviceProductIdPropertyInfo), '("scrollLockState", DeviceScrollLockStatePropertyInfo), '("seat", DeviceSeatPropertyInfo), '("source", DeviceSourcePropertyInfo), '("tool", DeviceToolPropertyInfo), '("vendorId", DeviceVendorIdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
deviceCapsLockState :: AttrLabelProxy "capsLockState"
deviceCapsLockState = AttrLabelProxy

deviceDirection :: AttrLabelProxy "direction"
deviceDirection = AttrLabelProxy

deviceDisplay :: AttrLabelProxy "display"
deviceDisplay = AttrLabelProxy

deviceHasCursor :: AttrLabelProxy "hasCursor"
deviceHasCursor = AttrLabelProxy

deviceModifierState :: AttrLabelProxy "modifierState"
deviceModifierState = AttrLabelProxy

deviceNAxes :: AttrLabelProxy "nAxes"
deviceNAxes = AttrLabelProxy

deviceName :: AttrLabelProxy "name"
deviceName = AttrLabelProxy

deviceNumLockState :: AttrLabelProxy "numLockState"
deviceNumLockState = AttrLabelProxy

deviceNumTouches :: AttrLabelProxy "numTouches"
deviceNumTouches = AttrLabelProxy

deviceProductId :: AttrLabelProxy "productId"
deviceProductId = AttrLabelProxy

deviceScrollLockState :: AttrLabelProxy "scrollLockState"
deviceScrollLockState = AttrLabelProxy

deviceSeat :: AttrLabelProxy "seat"
deviceSeat = AttrLabelProxy

deviceSource :: AttrLabelProxy "source"
deviceSource = AttrLabelProxy

deviceTool :: AttrLabelProxy "tool"
deviceTool = AttrLabelProxy

deviceVendorId :: AttrLabelProxy "vendorId"
deviceVendorId = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Device = DeviceSignalList
type DeviceSignalList = ('[ '("changed", DeviceChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("toolChanged", DeviceToolChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Device::get_caps_lock_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_caps_lock_state" gdk_device_get_caps_lock_state :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CInt

-- | Retrieves whether the Caps Lock modifier of the
-- keyboard is locked, if /@device@/ is a keyboard device.
deviceGetCapsLockState ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if Caps Lock is on for /@device@/
deviceGetCapsLockState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Bool
deviceGetCapsLockState a
device = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr Device -> IO CInt
gdk_device_get_caps_lock_state Ptr Device
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetCapsLockStateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetCapsLockStateMethodInfo a signature where
    overloadedMethod = deviceGetCapsLockState

instance O.OverloadedMethodInfo DeviceGetCapsLockStateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetCapsLockState",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetCapsLockState"
        }


#endif

-- method Device::get_device_tool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "DeviceTool" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_device_tool" gdk_device_get_device_tool :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO (Ptr Gdk.DeviceTool.DeviceTool)

-- | Retrieves the t'GI.Gdk.Objects.DeviceTool.DeviceTool' associated to /@device@/.
deviceGetDeviceTool ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Gdk.DeviceTool.DeviceTool
    -- ^ __Returns:__ the t'GI.Gdk.Objects.DeviceTool.DeviceTool'
deviceGetDeviceTool :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m DeviceTool
deviceGetDeviceTool a
device = IO DeviceTool -> m DeviceTool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DeviceTool -> m DeviceTool) -> IO DeviceTool -> m DeviceTool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr DeviceTool
result <- Ptr Device -> IO (Ptr DeviceTool)
gdk_device_get_device_tool Ptr Device
device'
    Text -> Ptr DeviceTool -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceGetDeviceTool" Ptr DeviceTool
result
    DeviceTool
result' <- ((ManagedPtr DeviceTool -> DeviceTool)
-> Ptr DeviceTool -> IO DeviceTool
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DeviceTool -> DeviceTool
Gdk.DeviceTool.DeviceTool) Ptr DeviceTool
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    DeviceTool -> IO DeviceTool
forall (m :: * -> *) a. Monad m => a -> m a
return DeviceTool
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetDeviceToolMethodInfo
instance (signature ~ (m Gdk.DeviceTool.DeviceTool), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetDeviceToolMethodInfo a signature where
    overloadedMethod = deviceGetDeviceTool

instance O.OverloadedMethodInfo DeviceGetDeviceToolMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetDeviceTool",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetDeviceTool"
        }


#endif

-- method Device::get_direction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Pango" , name = "Direction" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_direction" gdk_device_get_direction :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CUInt

-- | Returns the direction of effective layout of the keyboard,
-- if /@device@/ is a keyboard device.
-- 
-- The direction of a layout is the direction of the majority
-- of its symbols. See 'GI.Pango.Functions.unicharDirection'.
deviceGetDirection ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Pango.Enums.Direction
    -- ^ __Returns:__ 'GI.Pango.Enums.DirectionLtr' or 'GI.Pango.Enums.DirectionRtl'
    --   if it can determine the direction. 'GI.Pango.Enums.DirectionNeutral'
    --   otherwise
deviceGetDirection :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Direction
deviceGetDirection a
device = IO Direction -> m Direction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Direction -> m Direction) -> IO Direction -> m Direction
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr Device -> IO CUInt
gdk_device_get_direction Ptr Device
device'
    let result' :: Direction
result' = (Int -> Direction
forall a. Enum a => Int -> a
toEnum (Int -> Direction) -> (CUInt -> Int) -> CUInt -> Direction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Direction -> IO Direction
forall (m :: * -> *) a. Monad m => a -> m a
return Direction
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetDirectionMethodInfo
instance (signature ~ (m Pango.Enums.Direction), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetDirectionMethodInfo a signature where
    overloadedMethod = deviceGetDirection

instance O.OverloadedMethodInfo DeviceGetDirectionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetDirection",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetDirection"
        }


#endif

-- method Device::get_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Display" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_display" gdk_device_get_display :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO (Ptr Gdk.Display.Display)

-- | Returns the t'GI.Gdk.Objects.Display.Display' to which /@device@/ pertains.
deviceGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Gdk.Display.Display
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Display.Display'. This memory is owned
    --          by GTK, and must not be freed or unreffed.
deviceGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Display
deviceGetDisplay a
device = IO Display -> m Display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Display -> m Display) -> IO Display -> m Display
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Display
result <- Ptr Device -> IO (Ptr Display)
gdk_device_get_display Ptr Device
device'
    Text -> Ptr Display -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceGetDisplay" Ptr Display
result
    Display
result' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetDisplayMethodInfo a signature where
    overloadedMethod = deviceGetDisplay

instance O.OverloadedMethodInfo DeviceGetDisplayMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetDisplay",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetDisplay"
        }


#endif

-- method Device::get_has_cursor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_has_cursor" gdk_device_get_has_cursor :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CInt

-- | Determines whether the pointer follows device motion.
-- This is not meaningful for keyboard devices, which
-- don\'t have a pointer.
deviceGetHasCursor ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the pointer follows device motion
deviceGetHasCursor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Bool
deviceGetHasCursor a
device = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr Device -> IO CInt
gdk_device_get_has_cursor Ptr Device
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetHasCursorMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetHasCursorMethodInfo a signature where
    overloadedMethod = deviceGetHasCursor

instance O.OverloadedMethodInfo DeviceGetHasCursorMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetHasCursor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetHasCursor"
        }


#endif

-- method Device::get_modifier_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ModifierType" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_modifier_state" gdk_device_get_modifier_state :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CUInt

-- | Retrieves the current modifier state of the keyboard,
-- if /@device@/ is a keyboard device.
deviceGetModifierState ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m [Gdk.Flags.ModifierType]
    -- ^ __Returns:__ the current modifier state
deviceGetModifierState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m [ModifierType]
deviceGetModifierState a
device = IO [ModifierType] -> m [ModifierType]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ModifierType] -> m [ModifierType])
-> IO [ModifierType] -> m [ModifierType]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr Device -> IO CUInt
gdk_device_get_modifier_state Ptr Device
device'
    let result' :: [ModifierType]
result' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    [ModifierType] -> IO [ModifierType]
forall (m :: * -> *) a. Monad m => a -> m a
return [ModifierType]
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetModifierStateMethodInfo
instance (signature ~ (m [Gdk.Flags.ModifierType]), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetModifierStateMethodInfo a signature where
    overloadedMethod = deviceGetModifierState

instance O.OverloadedMethodInfo DeviceGetModifierStateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetModifierState",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetModifierState"
        }


#endif

-- method Device::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_name" gdk_device_get_name :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CString

-- | Determines the name of the device, suitable
-- for showing in a user interface.
deviceGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m T.Text
    -- ^ __Returns:__ a name
deviceGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Text
deviceGetName a
device = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CString
result <- Ptr Device -> IO CString
gdk_device_get_name Ptr Device
device'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetNameMethodInfo a signature where
    overloadedMethod = deviceGetName

instance O.OverloadedMethodInfo DeviceGetNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetName"
        }


#endif

-- method Device::get_num_lock_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_num_lock_state" gdk_device_get_num_lock_state :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CInt

-- | Retrieves whether the Num Lock modifier of the
-- keyboard is locked, if /@device@/ is a keyboard device.
deviceGetNumLockState ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if Num Lock is on for /@device@/
deviceGetNumLockState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Bool
deviceGetNumLockState a
device = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr Device -> IO CInt
gdk_device_get_num_lock_state Ptr Device
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetNumLockStateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetNumLockStateMethodInfo a signature where
    overloadedMethod = deviceGetNumLockState

instance O.OverloadedMethodInfo DeviceGetNumLockStateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetNumLockState",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetNumLockState"
        }


#endif

-- method Device::get_num_touches
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_num_touches" gdk_device_get_num_touches :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO Word32

-- | Retrieves the number of touch points associated to /@device@/.
deviceGetNumTouches ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Word32
    -- ^ __Returns:__ the number of touch points
deviceGetNumTouches :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Word32
deviceGetNumTouches a
device = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Word32
result <- Ptr Device -> IO Word32
gdk_device_get_num_touches Ptr Device
device'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DeviceGetNumTouchesMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetNumTouchesMethodInfo a signature where
    overloadedMethod = deviceGetNumTouches

instance O.OverloadedMethodInfo DeviceGetNumTouchesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetNumTouches",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetNumTouches"
        }


#endif

-- method Device::get_product_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a physical #GdkDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_product_id" gdk_device_get_product_id :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CString

-- | Returns the product ID of this device, or 'P.Nothing' if this information couldn\'t
-- be obtained. This ID is retrieved from the device, and is thus constant for
-- it. See 'GI.Gdk.Objects.Device.deviceGetVendorId' for more information.
deviceGetProductId ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a physical t'GI.Gdk.Objects.Device.Device'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the product ID, or 'P.Nothing'
deviceGetProductId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m (Maybe Text)
deviceGetProductId a
device = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CString
result <- Ptr Device -> IO CString
gdk_device_get_product_id Ptr Device
device'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DeviceGetProductIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetProductIdMethodInfo a signature where
    overloadedMethod = deviceGetProductId

instance O.OverloadedMethodInfo DeviceGetProductIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetProductId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetProductId"
        }


#endif

-- method Device::get_scroll_lock_state
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_scroll_lock_state" gdk_device_get_scroll_lock_state :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CInt

-- | Retrieves whether the Scroll Lock modifier of the
-- keyboard is locked, if /@device@/ is a keyboard device.
deviceGetScrollLockState ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if Scroll Lock is on for /@device@/
deviceGetScrollLockState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Bool
deviceGetScrollLockState a
device = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr Device -> IO CInt
gdk_device_get_scroll_lock_state Ptr Device
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetScrollLockStateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetScrollLockStateMethodInfo a signature where
    overloadedMethod = deviceGetScrollLockState

instance O.OverloadedMethodInfo DeviceGetScrollLockStateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetScrollLockState",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetScrollLockState"
        }


#endif

-- method Device::get_seat
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Seat" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_seat" gdk_device_get_seat :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO (Ptr Gdk.Seat.Seat)

-- | Returns the t'GI.Gdk.Objects.Seat.Seat' the device belongs to.
deviceGetSeat ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: A t'GI.Gdk.Objects.Device.Device'
    -> m Gdk.Seat.Seat
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Seat.Seat'
deviceGetSeat :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Seat
deviceGetSeat a
device = IO Seat -> m Seat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Seat -> m Seat) -> IO Seat -> m Seat
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr Seat
result <- Ptr Device -> IO (Ptr Seat)
gdk_device_get_seat Ptr Device
device'
    Text -> Ptr Seat -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"deviceGetSeat" Ptr Seat
result
    Seat
result' <- ((ManagedPtr Seat -> Seat) -> Ptr Seat -> IO Seat
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Seat -> Seat
Gdk.Seat.Seat) Ptr Seat
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Seat -> IO Seat
forall (m :: * -> *) a. Monad m => a -> m a
return Seat
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetSeatMethodInfo
instance (signature ~ (m Gdk.Seat.Seat), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetSeatMethodInfo a signature where
    overloadedMethod = deviceGetSeat

instance O.OverloadedMethodInfo DeviceGetSeatMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetSeat",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetSeat"
        }


#endif

-- method Device::get_source
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "InputSource" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_source" gdk_device_get_source :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CUInt

-- | Determines the type of the device.
deviceGetSource ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Gdk.Enums.InputSource
    -- ^ __Returns:__ a t'GI.Gdk.Enums.InputSource'
deviceGetSource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m InputSource
deviceGetSource a
device = IO InputSource -> m InputSource
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputSource -> m InputSource)
-> IO InputSource -> m InputSource
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CUInt
result <- Ptr Device -> IO CUInt
gdk_device_get_source Ptr Device
device'
    let result' :: InputSource
result' = (Int -> InputSource
forall a. Enum a => Int -> a
toEnum (Int -> InputSource) -> (CUInt -> Int) -> CUInt -> InputSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    InputSource -> IO InputSource
forall (m :: * -> *) a. Monad m => a -> m a
return InputSource
result'

#if defined(ENABLE_OVERLOADING)
data DeviceGetSourceMethodInfo
instance (signature ~ (m Gdk.Enums.InputSource), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetSourceMethodInfo a signature where
    overloadedMethod = deviceGetSource

instance O.OverloadedMethodInfo DeviceGetSourceMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetSource",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetSource"
        }


#endif

-- method Device::get_surface_at_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "pointer #GdkDevice to query info to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "win_x"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the X coordinate of the device location,\n        relative to the surface origin, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "win_y"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the Y coordinate of the device location,\n        relative to the surface origin, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Surface" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_surface_at_position" gdk_device_get_surface_at_position :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    Ptr CDouble ->                          -- win_x : TBasicType TDouble
    Ptr CDouble ->                          -- win_y : TBasicType TDouble
    IO (Ptr Gdk.Surface.Surface)

-- | Obtains the surface underneath /@device@/, returning the location of the device in /@winX@/ and /@winY@/ in
-- double precision. Returns 'P.Nothing' if the surface tree under /@device@/ is not known to GDK (for example,
-- belongs to another application).
deviceGetSurfaceAtPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: pointer t'GI.Gdk.Objects.Device.Device' to query info to.
    -> m ((Maybe Gdk.Surface.Surface, Double, Double))
    -- ^ __Returns:__ the t'GI.Gdk.Objects.Surface.Surface' under the
    --   device position, or 'P.Nothing'.
deviceGetSurfaceAtPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m (Maybe Surface, Double, Double)
deviceGetSurfaceAtPosition a
device = IO (Maybe Surface, Double, Double)
-> m (Maybe Surface, Double, Double)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Surface, Double, Double)
 -> m (Maybe Surface, Double, Double))
-> IO (Maybe Surface, Double, Double)
-> m (Maybe Surface, Double, Double)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    Ptr CDouble
winX <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CDouble
winY <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr Surface
result <- Ptr Device -> Ptr CDouble -> Ptr CDouble -> IO (Ptr Surface)
gdk_device_get_surface_at_position Ptr Device
device' Ptr CDouble
winX Ptr CDouble
winY
    Maybe Surface
maybeResult <- Ptr Surface -> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Surface
result ((Ptr Surface -> IO Surface) -> IO (Maybe Surface))
-> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Surface
result' -> do
        Surface
result'' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
result'
        Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result''
    CDouble
winX' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
winX
    let winX'' :: Double
winX'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
winX'
    CDouble
winY' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
winY
    let winY'' :: Double
winY'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
winY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
winX
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
winY
    (Maybe Surface, Double, Double)
-> IO (Maybe Surface, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Surface
maybeResult, Double
winX'', Double
winY'')

#if defined(ENABLE_OVERLOADING)
data DeviceGetSurfaceAtPositionMethodInfo
instance (signature ~ (m ((Maybe Gdk.Surface.Surface, Double, Double))), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetSurfaceAtPositionMethodInfo a signature where
    overloadedMethod = deviceGetSurfaceAtPosition

instance O.OverloadedMethodInfo DeviceGetSurfaceAtPositionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetSurfaceAtPosition",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetSurfaceAtPosition"
        }


#endif

-- method Device::get_vendor_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a physical #GdkDevice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_get_vendor_id" gdk_device_get_vendor_id :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CString

-- | Returns the vendor ID of this device, or 'P.Nothing' if this information couldn\'t
-- be obtained. This ID is retrieved from the device, and is thus constant for
-- it.
-- 
-- This function, together with 'GI.Gdk.Objects.Device.deviceGetProductId', can be used to eg.
-- compose t'GI.Gio.Objects.Settings.Settings' paths to store settings for this device.
-- 
-- 
-- === /C code/
-- >
-- > static GSettings *
-- > get_device_settings (GdkDevice *device)
-- > {
-- >   const char *vendor, *product;
-- >   GSettings *settings;
-- >   GdkDevice *device;
-- >   char *path;
-- >
-- >   vendor = gdk_device_get_vendor_id (device);
-- >   product = gdk_device_get_product_id (device);
-- >
-- >   path = g_strdup_printf ("/org/example/app/devices/%s:%s/", vendor, product);
-- >   settings = g_settings_new_with_path (DEVICE_SCHEMA, path);
-- >   g_free (path);
-- >
-- >   return settings;
-- > }
deviceGetVendorId ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a physical t'GI.Gdk.Objects.Device.Device'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the vendor ID, or 'P.Nothing'
deviceGetVendorId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m (Maybe Text)
deviceGetVendorId a
device = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CString
result <- Ptr Device -> IO CString
gdk_device_get_vendor_id Ptr Device
device'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data DeviceGetVendorIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceGetVendorIdMethodInfo a signature where
    overloadedMethod = deviceGetVendorId

instance O.OverloadedMethodInfo DeviceGetVendorIdMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceGetVendorId",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceGetVendorId"
        }


#endif

-- method Device::has_bidi_layouts
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDevice" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_device_has_bidi_layouts" gdk_device_has_bidi_layouts :: 
    Ptr Device ->                           -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    IO CInt

-- | Determines if keyboard layouts for both right-to-left and
-- left-to-right languages are in use on the keyboard, if
-- /@device@/ is a keyboard device.
deviceHasBidiLayouts ::
    (B.CallStack.HasCallStack, MonadIO m, IsDevice a) =>
    a
    -- ^ /@device@/: a t'GI.Gdk.Objects.Device.Device'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if there are layouts with both directions,
    --     'P.False' otherwise
deviceHasBidiLayouts :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDevice a) =>
a -> m Bool
deviceHasBidiLayouts a
device = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Device
device' <- a -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
device
    CInt
result <- Ptr Device -> IO CInt
gdk_device_has_bidi_layouts Ptr Device
device'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
device
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DeviceHasBidiLayoutsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDevice a) => O.OverloadedMethod DeviceHasBidiLayoutsMethodInfo a signature where
    overloadedMethod = deviceHasBidiLayouts

instance O.OverloadedMethodInfo DeviceHasBidiLayoutsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Objects.Device.deviceHasBidiLayouts",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Objects-Device.html#v:deviceHasBidiLayouts"
        }


#endif