{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.DragAction.DragAction' structure contains only
-- private data and should be accessed using the provided API
-- 
-- /Since: 1.4/

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

module GI.Clutter.Objects.DragAction
    ( 

-- * Exported types
    DragAction(..)                          ,
    IsDragAction                            ,
    toDragAction                            ,


 -- * 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"), [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
-- [getActor]("GI.Clutter.Objects.ActorMeta#g:method:getActor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDragArea]("GI.Clutter.Objects.DragAction#g:method:getDragArea"), [getDragAxis]("GI.Clutter.Objects.DragAction#g:method:getDragAxis"), [getDragHandle]("GI.Clutter.Objects.DragAction#g:method:getDragHandle"), [getDragThreshold]("GI.Clutter.Objects.DragAction#g:method:getDragThreshold"), [getEnabled]("GI.Clutter.Objects.ActorMeta#g:method:getEnabled"), [getMotionCoords]("GI.Clutter.Objects.DragAction#g:method:getMotionCoords"), [getName]("GI.Clutter.Objects.ActorMeta#g:method:getName"), [getPressCoords]("GI.Clutter.Objects.DragAction#g:method:getPressCoords"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDragArea]("GI.Clutter.Objects.DragAction#g:method:setDragArea"), [setDragAxis]("GI.Clutter.Objects.DragAction#g:method:setDragAxis"), [setDragHandle]("GI.Clutter.Objects.DragAction#g:method:setDragHandle"), [setDragThreshold]("GI.Clutter.Objects.DragAction#g:method:setDragThreshold"), [setEnabled]("GI.Clutter.Objects.ActorMeta#g:method:setEnabled"), [setName]("GI.Clutter.Objects.ActorMeta#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDragActionMethod                 ,
#endif

-- ** getDragArea #method:getDragArea#

#if defined(ENABLE_OVERLOADING)
    DragActionGetDragAreaMethodInfo         ,
#endif
    dragActionGetDragArea                   ,


-- ** getDragAxis #method:getDragAxis#

#if defined(ENABLE_OVERLOADING)
    DragActionGetDragAxisMethodInfo         ,
#endif
    dragActionGetDragAxis                   ,


-- ** getDragHandle #method:getDragHandle#

#if defined(ENABLE_OVERLOADING)
    DragActionGetDragHandleMethodInfo       ,
#endif
    dragActionGetDragHandle                 ,


-- ** getDragThreshold #method:getDragThreshold#

#if defined(ENABLE_OVERLOADING)
    DragActionGetDragThresholdMethodInfo    ,
#endif
    dragActionGetDragThreshold              ,


-- ** getMotionCoords #method:getMotionCoords#

#if defined(ENABLE_OVERLOADING)
    DragActionGetMotionCoordsMethodInfo     ,
#endif
    dragActionGetMotionCoords               ,


-- ** getPressCoords #method:getPressCoords#

#if defined(ENABLE_OVERLOADING)
    DragActionGetPressCoordsMethodInfo      ,
#endif
    dragActionGetPressCoords                ,


-- ** new #method:new#

    dragActionNew                           ,


-- ** setDragArea #method:setDragArea#

#if defined(ENABLE_OVERLOADING)
    DragActionSetDragAreaMethodInfo         ,
#endif
    dragActionSetDragArea                   ,


-- ** setDragAxis #method:setDragAxis#

#if defined(ENABLE_OVERLOADING)
    DragActionSetDragAxisMethodInfo         ,
#endif
    dragActionSetDragAxis                   ,


-- ** setDragHandle #method:setDragHandle#

#if defined(ENABLE_OVERLOADING)
    DragActionSetDragHandleMethodInfo       ,
#endif
    dragActionSetDragHandle                 ,


-- ** setDragThreshold #method:setDragThreshold#

#if defined(ENABLE_OVERLOADING)
    DragActionSetDragThresholdMethodInfo    ,
#endif
    dragActionSetDragThreshold              ,




 -- * Properties


-- ** dragArea #attr:dragArea#
-- | Constains the dragging action (or in particular, the resulting
-- actor position) to the specified t'GI.Clutter.Structs.Rect.Rect', in parent\'s
-- coordinates.
-- 
-- /Since: 1.12/

#if defined(ENABLE_OVERLOADING)
    DragActionDragAreaPropertyInfo          ,
#endif
    clearDragActionDragArea                 ,
    constructDragActionDragArea             ,
#if defined(ENABLE_OVERLOADING)
    dragActionDragArea                      ,
#endif
    getDragActionDragArea                   ,
    setDragActionDragArea                   ,


-- ** dragAreaSet #attr:dragAreaSet#
-- | Whether the t'GI.Clutter.Objects.DragAction.DragAction':@/drag-area/@ property has been set.
-- 
-- /Since: 1.12/

#if defined(ENABLE_OVERLOADING)
    DragActionDragAreaSetPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    dragActionDragAreaSet                   ,
#endif
    getDragActionDragAreaSet                ,


-- ** dragAxis #attr:dragAxis#
-- | Constraints the dragging action to the specified axis
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    DragActionDragAxisPropertyInfo          ,
#endif
    constructDragActionDragAxis             ,
#if defined(ENABLE_OVERLOADING)
    dragActionDragAxis                      ,
#endif
    getDragActionDragAxis                   ,
    setDragActionDragAxis                   ,


-- ** dragHandle #attr:dragHandle#
-- | The t'GI.Clutter.Objects.Actor.Actor' that is effectively being dragged
-- 
-- A t'GI.Clutter.Objects.DragAction.DragAction' will, be default, use the t'GI.Clutter.Objects.Actor.Actor' that
-- has been attached to the action; it is possible to create a
-- separate t'GI.Clutter.Objects.Actor.Actor' and use it instead.
-- 
-- Setting this property has no effect on the t'GI.Clutter.Objects.Actor.Actor' argument
-- passed to the t'GI.Clutter.Objects.DragAction.DragAction' signals
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    DragActionDragHandlePropertyInfo        ,
#endif
    clearDragActionDragHandle               ,
    constructDragActionDragHandle           ,
#if defined(ENABLE_OVERLOADING)
    dragActionDragHandle                    ,
#endif
    getDragActionDragHandle                 ,
    setDragActionDragHandle                 ,


-- ** xDragThreshold #attr:xDragThreshold#
-- | The horizontal threshold, in pixels, that the cursor must travel
-- in order to begin a drag action.
-- 
-- When set to a positive value, t'GI.Clutter.Objects.DragAction.DragAction' will only emit
-- [dragBegin]("GI.Clutter.Objects.DragAction#g:signal:dragBegin") if the pointer has moved
-- horizontally at least of the given amount of pixels since
-- the button press event.
-- 
-- When set to -1, t'GI.Clutter.Objects.DragAction.DragAction' will use the default threshold
-- stored in the t'GI.Clutter.Objects.Settings.Settings':@/dnd-drag-threshold/@ property of
-- t'GI.Clutter.Objects.Settings.Settings'.
-- 
-- When read, this property will always return a valid drag
-- threshold, either as set or the default one.
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    DragActionXDragThresholdPropertyInfo    ,
#endif
    constructDragActionXDragThreshold       ,
#if defined(ENABLE_OVERLOADING)
    dragActionXDragThreshold                ,
#endif
    getDragActionXDragThreshold             ,
    setDragActionXDragThreshold             ,


-- ** yDragThreshold #attr:yDragThreshold#
-- | The vertical threshold, in pixels, that the cursor must travel
-- in order to begin a drag action.
-- 
-- When set to a positive value, t'GI.Clutter.Objects.DragAction.DragAction' will only emit
-- [dragBegin]("GI.Clutter.Objects.DragAction#g:signal:dragBegin") if the pointer has moved
-- vertically at least of the given amount of pixels since
-- the button press event.
-- 
-- When set to -1, t'GI.Clutter.Objects.DragAction.DragAction' will use the value stored
-- in the t'GI.Clutter.Objects.Settings.Settings':@/dnd-drag-threshold/@ property of
-- t'GI.Clutter.Objects.Settings.Settings'.
-- 
-- When read, this property will always return a valid drag
-- threshold, either as set or the default one.
-- 
-- /Since: 1.4/

#if defined(ENABLE_OVERLOADING)
    DragActionYDragThresholdPropertyInfo    ,
#endif
    constructDragActionYDragThreshold       ,
#if defined(ENABLE_OVERLOADING)
    dragActionYDragThreshold                ,
#endif
    getDragActionYDragThreshold             ,
    setDragActionYDragThreshold             ,




 -- * Signals


-- ** dragBegin #signal:dragBegin#

    DragActionDragBeginCallback             ,
#if defined(ENABLE_OVERLOADING)
    DragActionDragBeginSignalInfo           ,
#endif
    afterDragActionDragBegin                ,
    onDragActionDragBegin                   ,


-- ** dragEnd #signal:dragEnd#

    DragActionDragEndCallback               ,
#if defined(ENABLE_OVERLOADING)
    DragActionDragEndSignalInfo             ,
#endif
    afterDragActionDragEnd                  ,
    onDragActionDragEnd                     ,


-- ** dragMotion #signal:dragMotion#

    DragActionDragMotionCallback            ,
#if defined(ENABLE_OVERLOADING)
    DragActionDragMotionSignalInfo          ,
#endif
    afterDragActionDragMotion               ,
    onDragActionDragMotion                  ,


-- ** dragProgress #signal:dragProgress#

    DragActionDragProgressCallback          ,
#if defined(ENABLE_OVERLOADING)
    DragActionDragProgressSignalInfo        ,
#endif
    afterDragActionDragProgress             ,
    onDragActionDragProgress                ,




    ) 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.Coerce as Coerce
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 {-# SOURCE #-} qualified GI.Clutter.Enums as Clutter.Enums
import {-# SOURCE #-} qualified GI.Clutter.Flags as Clutter.Flags
import {-# SOURCE #-} qualified GI.Clutter.Objects.Action as Clutter.Action
import {-# SOURCE #-} qualified GI.Clutter.Objects.Actor as Clutter.Actor
import {-# SOURCE #-} qualified GI.Clutter.Objects.ActorMeta as Clutter.ActorMeta
import {-# SOURCE #-} qualified GI.Clutter.Structs.Rect as Clutter.Rect
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_drag_action_get_type"
    c_clutter_drag_action_get_type :: IO B.Types.GType

instance B.Types.TypedObject DragAction where
    glibType :: IO GType
glibType = IO GType
c_clutter_drag_action_get_type

instance B.Types.GObject DragAction

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

instance O.HasParentTypes DragAction
type instance O.ParentTypes DragAction = '[Clutter.Action.Action, Clutter.ActorMeta.ActorMeta, GObject.Object.Object]

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

-- | Convert 'DragAction' 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 DragAction) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_clutter_drag_action_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DragAction -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DragAction
P.Nothing = Ptr GValue -> Ptr DragAction -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr DragAction
forall a. Ptr a
FP.nullPtr :: FP.Ptr DragAction)
    gvalueSet_ Ptr GValue
gv (P.Just DragAction
obj) = DragAction -> (Ptr DragAction -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DragAction
obj (Ptr GValue -> Ptr DragAction -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DragAction)
gvalueGet_ Ptr GValue
gv = do
        Ptr DragAction
ptr <- Ptr GValue -> IO (Ptr DragAction)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr DragAction)
        if Ptr DragAction
ptr Ptr DragAction -> Ptr DragAction -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr DragAction
forall a. Ptr a
FP.nullPtr
        then DragAction -> Maybe DragAction
forall a. a -> Maybe a
P.Just (DragAction -> Maybe DragAction)
-> IO DragAction -> IO (Maybe DragAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr DragAction -> DragAction)
-> Ptr DragAction -> IO DragAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DragAction -> DragAction
DragAction Ptr DragAction
ptr
        else Maybe DragAction -> IO (Maybe DragAction)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DragAction
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveDragActionMethod (t :: Symbol) (o :: *) :: * where
    ResolveDragActionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDragActionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDragActionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDragActionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDragActionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDragActionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDragActionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDragActionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDragActionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDragActionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDragActionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDragActionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDragActionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDragActionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDragActionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDragActionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDragActionMethod "getActor" o = Clutter.ActorMeta.ActorMetaGetActorMethodInfo
    ResolveDragActionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDragActionMethod "getDragArea" o = DragActionGetDragAreaMethodInfo
    ResolveDragActionMethod "getDragAxis" o = DragActionGetDragAxisMethodInfo
    ResolveDragActionMethod "getDragHandle" o = DragActionGetDragHandleMethodInfo
    ResolveDragActionMethod "getDragThreshold" o = DragActionGetDragThresholdMethodInfo
    ResolveDragActionMethod "getEnabled" o = Clutter.ActorMeta.ActorMetaGetEnabledMethodInfo
    ResolveDragActionMethod "getMotionCoords" o = DragActionGetMotionCoordsMethodInfo
    ResolveDragActionMethod "getName" o = Clutter.ActorMeta.ActorMetaGetNameMethodInfo
    ResolveDragActionMethod "getPressCoords" o = DragActionGetPressCoordsMethodInfo
    ResolveDragActionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDragActionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDragActionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDragActionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDragActionMethod "setDragArea" o = DragActionSetDragAreaMethodInfo
    ResolveDragActionMethod "setDragAxis" o = DragActionSetDragAxisMethodInfo
    ResolveDragActionMethod "setDragHandle" o = DragActionSetDragHandleMethodInfo
    ResolveDragActionMethod "setDragThreshold" o = DragActionSetDragThresholdMethodInfo
    ResolveDragActionMethod "setEnabled" o = Clutter.ActorMeta.ActorMetaSetEnabledMethodInfo
    ResolveDragActionMethod "setName" o = Clutter.ActorMeta.ActorMetaSetNameMethodInfo
    ResolveDragActionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDragActionMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDragActionMethod t DragAction, O.OverloadedMethod info DragAction p) => OL.IsLabel t (DragAction -> 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 ~ ResolveDragActionMethod t DragAction, O.OverloadedMethod info DragAction p, R.HasField t DragAction p) => R.HasField t DragAction p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal DragAction::drag-begin
-- | The [dragBegin](#g:signal:dragBegin) signal is emitted when the t'GI.Clutter.Objects.DragAction.DragAction'
-- starts the dragging
-- 
-- The emission of this signal can be delayed by using the
-- t'GI.Clutter.Objects.DragAction.DragAction':@/x-drag-threshold/@ and
-- t'GI.Clutter.Objects.DragAction.DragAction':@/y-drag-threshold/@ properties
-- 
-- /Since: 1.4/
type DragActionDragBeginCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the action
    -> Float
    -- ^ /@eventX@/: the X coordinate (in stage space) of the press event
    -> Float
    -- ^ /@eventY@/: the Y coordinate (in stage space) of the press event
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: the modifiers of the press event
    -> IO ()

type C_DragActionDragBeginCallback =
    Ptr DragAction ->                       -- object
    Ptr Clutter.Actor.Actor ->
    CFloat ->
    CFloat ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DragActionDragBeginCallback :: 
    GObject a => (a -> DragActionDragBeginCallback) ->
    C_DragActionDragBeginCallback
wrap_DragActionDragBeginCallback :: forall a.
GObject a =>
(a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
wrap_DragActionDragBeginCallback a -> DragActionDragBeginCallback
gi'cb Ptr DragAction
gi'selfPtr Ptr Actor
actor CFloat
eventX CFloat
eventY CUInt
modifiers Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    let eventX' :: Float
eventX' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
eventX
    let eventY' :: Float
eventY' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
eventY
    let modifiers' :: [ModifierType]
modifiers' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
modifiers
    Ptr DragAction -> (DragAction -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragAction
gi'selfPtr ((DragAction -> IO ()) -> IO ()) -> (DragAction -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DragAction
gi'self -> a -> DragActionDragBeginCallback
gi'cb (DragAction -> a
Coerce.coerce DragAction
gi'self)  Actor
actor' Float
eventX' Float
eventY' [ModifierType]
modifiers'


-- | Connect a signal handler for the [dragBegin](#signal:dragBegin) 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' dragAction #dragBegin callback
-- @
-- 
-- 
onDragActionDragBegin :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragBeginCallback) -> m SignalHandlerId
onDragActionDragBegin :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragBeginCallback) -> m SignalHandlerId
onDragActionDragBegin a
obj (?self::a) => DragActionDragBeginCallback
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 wrapped :: a -> DragActionDragBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragBeginCallback
DragActionDragBeginCallback
cb
    let wrapped' :: C_DragActionDragBeginCallback
wrapped' = (a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
forall a.
GObject a =>
(a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
wrap_DragActionDragBeginCallback a -> DragActionDragBeginCallback
wrapped
    FunPtr C_DragActionDragBeginCallback
wrapped'' <- C_DragActionDragBeginCallback
-> IO (FunPtr C_DragActionDragBeginCallback)
mk_DragActionDragBeginCallback C_DragActionDragBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-begin" FunPtr C_DragActionDragBeginCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragBegin](#signal:dragBegin) 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' dragAction #dragBegin callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragActionDragBegin :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragBeginCallback) -> m SignalHandlerId
afterDragActionDragBegin :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragBeginCallback) -> m SignalHandlerId
afterDragActionDragBegin a
obj (?self::a) => DragActionDragBeginCallback
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 wrapped :: a -> DragActionDragBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragBeginCallback
DragActionDragBeginCallback
cb
    let wrapped' :: C_DragActionDragBeginCallback
wrapped' = (a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
forall a.
GObject a =>
(a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
wrap_DragActionDragBeginCallback a -> DragActionDragBeginCallback
wrapped
    FunPtr C_DragActionDragBeginCallback
wrapped'' <- C_DragActionDragBeginCallback
-> IO (FunPtr C_DragActionDragBeginCallback)
mk_DragActionDragBeginCallback C_DragActionDragBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-begin" FunPtr C_DragActionDragBeginCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragActionDragBeginSignalInfo
instance SignalInfo DragActionDragBeginSignalInfo where
    type HaskellCallbackType DragActionDragBeginSignalInfo = DragActionDragBeginCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragActionDragBeginCallback cb
        cb'' <- mk_DragActionDragBeginCallback cb'
        connectSignalFunPtr obj "drag-begin" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction::drag-begin"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:signal:dragBegin"})

#endif

-- signal DragAction::drag-end
-- | The [dragEnd](#g:signal:dragEnd) signal is emitted at the end of the dragging,
-- when the pointer button\'s is released
-- 
-- This signal is emitted if and only if the [dragBegin]("GI.Clutter.Objects.DragAction#g:signal:dragBegin")
-- signal has been emitted first
-- 
-- /Since: 1.4/
type DragActionDragEndCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the action
    -> Float
    -- ^ /@eventX@/: the X coordinate (in stage space) of the release event
    -> Float
    -- ^ /@eventY@/: the Y coordinate (in stage space) of the release event
    -> [Clutter.Flags.ModifierType]
    -- ^ /@modifiers@/: the modifiers of the release event
    -> IO ()

type C_DragActionDragEndCallback =
    Ptr DragAction ->                       -- object
    Ptr Clutter.Actor.Actor ->
    CFloat ->
    CFloat ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DragActionDragEndCallback :: 
    GObject a => (a -> DragActionDragEndCallback) ->
    C_DragActionDragEndCallback
wrap_DragActionDragEndCallback :: forall a.
GObject a =>
(a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
wrap_DragActionDragEndCallback a -> DragActionDragBeginCallback
gi'cb Ptr DragAction
gi'selfPtr Ptr Actor
actor CFloat
eventX CFloat
eventY CUInt
modifiers Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    let eventX' :: Float
eventX' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
eventX
    let eventY' :: Float
eventY' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
eventY
    let modifiers' :: [ModifierType]
modifiers' = CUInt -> [ModifierType]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
modifiers
    Ptr DragAction -> (DragAction -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragAction
gi'selfPtr ((DragAction -> IO ()) -> IO ()) -> (DragAction -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DragAction
gi'self -> a -> DragActionDragBeginCallback
gi'cb (DragAction -> a
Coerce.coerce DragAction
gi'self)  Actor
actor' Float
eventX' Float
eventY' [ModifierType]
modifiers'


-- | Connect a signal handler for the [dragEnd](#signal:dragEnd) 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' dragAction #dragEnd callback
-- @
-- 
-- 
onDragActionDragEnd :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragEndCallback) -> m SignalHandlerId
onDragActionDragEnd :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragBeginCallback) -> m SignalHandlerId
onDragActionDragEnd a
obj (?self::a) => DragActionDragBeginCallback
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 wrapped :: a -> DragActionDragBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragBeginCallback
DragActionDragBeginCallback
cb
    let wrapped' :: C_DragActionDragBeginCallback
wrapped' = (a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
forall a.
GObject a =>
(a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
wrap_DragActionDragEndCallback a -> DragActionDragBeginCallback
wrapped
    FunPtr C_DragActionDragBeginCallback
wrapped'' <- C_DragActionDragBeginCallback
-> IO (FunPtr C_DragActionDragBeginCallback)
mk_DragActionDragEndCallback C_DragActionDragBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-end" FunPtr C_DragActionDragBeginCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragEnd](#signal:dragEnd) 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' dragAction #dragEnd callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragActionDragEnd :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragEndCallback) -> m SignalHandlerId
afterDragActionDragEnd :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragBeginCallback) -> m SignalHandlerId
afterDragActionDragEnd a
obj (?self::a) => DragActionDragBeginCallback
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 wrapped :: a -> DragActionDragBeginCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragBeginCallback
DragActionDragBeginCallback
cb
    let wrapped' :: C_DragActionDragBeginCallback
wrapped' = (a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
forall a.
GObject a =>
(a -> DragActionDragBeginCallback) -> C_DragActionDragBeginCallback
wrap_DragActionDragEndCallback a -> DragActionDragBeginCallback
wrapped
    FunPtr C_DragActionDragBeginCallback
wrapped'' <- C_DragActionDragBeginCallback
-> IO (FunPtr C_DragActionDragBeginCallback)
mk_DragActionDragEndCallback C_DragActionDragBeginCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragBeginCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-end" FunPtr C_DragActionDragBeginCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragActionDragEndSignalInfo
instance SignalInfo DragActionDragEndSignalInfo where
    type HaskellCallbackType DragActionDragEndSignalInfo = DragActionDragEndCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragActionDragEndCallback cb
        cb'' <- mk_DragActionDragEndCallback cb'
        connectSignalFunPtr obj "drag-end" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction::drag-end"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:signal:dragEnd"})

#endif

-- signal DragAction::drag-motion
-- | The [dragMotion](#g:signal:dragMotion) signal is emitted for each motion event after
-- the [dragBegin]("GI.Clutter.Objects.DragAction#g:signal:dragBegin") signal has been emitted.
-- 
-- The components of the distance between the press event and the
-- latest motion event are computed in the actor\'s coordinate space,
-- to take into account eventual transformations. If you want the
-- stage coordinates of the latest motion event you can use
-- 'GI.Clutter.Objects.DragAction.dragActionGetMotionCoords'.
-- 
-- The default handler of the signal will call 'GI.Clutter.Objects.Actor.actorMoveBy'
-- either on /@actor@/ or, if set, of t'GI.Clutter.Objects.DragAction.DragAction':@/drag-handle/@ using
-- the /@deltaX@/ and /@deltaY@/ components of the dragging motion. If you
-- want to override the default behaviour, you can connect to the
-- [dragProgress]("GI.Clutter.Objects.DragAction#g:signal:dragProgress") signal and return 'P.False' from the
-- handler.
-- 
-- /Since: 1.4/
type DragActionDragMotionCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the action
    -> Float
    -- ^ /@deltaX@/: the X component of the distance between the press event
    --   that began the dragging and the current position of the pointer,
    --   as of the latest motion event
    -> Float
    -- ^ /@deltaY@/: the Y component of the distance between the press event
    --   that began the dragging and the current position of the pointer,
    --   as of the latest motion event
    -> IO ()

type C_DragActionDragMotionCallback =
    Ptr DragAction ->                       -- object
    Ptr Clutter.Actor.Actor ->
    CFloat ->
    CFloat ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_DragActionDragMotionCallback :: 
    GObject a => (a -> DragActionDragMotionCallback) ->
    C_DragActionDragMotionCallback
wrap_DragActionDragMotionCallback :: forall a.
GObject a =>
(a -> DragActionDragMotionCallback)
-> C_DragActionDragMotionCallback
wrap_DragActionDragMotionCallback a -> DragActionDragMotionCallback
gi'cb Ptr DragAction
gi'selfPtr Ptr Actor
actor CFloat
deltaX CFloat
deltaY Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    let deltaX' :: Float
deltaX' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
deltaX
    let deltaY' :: Float
deltaY' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
deltaY
    Ptr DragAction -> (DragAction -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragAction
gi'selfPtr ((DragAction -> IO ()) -> IO ()) -> (DragAction -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DragAction
gi'self -> a -> DragActionDragMotionCallback
gi'cb (DragAction -> a
Coerce.coerce DragAction
gi'self)  Actor
actor' Float
deltaX' Float
deltaY'


-- | Connect a signal handler for the [dragMotion](#signal:dragMotion) 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' dragAction #dragMotion callback
-- @
-- 
-- 
onDragActionDragMotion :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragMotionCallback) -> m SignalHandlerId
onDragActionDragMotion :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragMotionCallback)
-> m SignalHandlerId
onDragActionDragMotion a
obj (?self::a) => DragActionDragMotionCallback
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 wrapped :: a -> DragActionDragMotionCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragMotionCallback
DragActionDragMotionCallback
cb
    let wrapped' :: C_DragActionDragMotionCallback
wrapped' = (a -> DragActionDragMotionCallback)
-> C_DragActionDragMotionCallback
forall a.
GObject a =>
(a -> DragActionDragMotionCallback)
-> C_DragActionDragMotionCallback
wrap_DragActionDragMotionCallback a -> DragActionDragMotionCallback
wrapped
    FunPtr C_DragActionDragMotionCallback
wrapped'' <- C_DragActionDragMotionCallback
-> IO (FunPtr C_DragActionDragMotionCallback)
mk_DragActionDragMotionCallback C_DragActionDragMotionCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragMotionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-motion" FunPtr C_DragActionDragMotionCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragMotion](#signal:dragMotion) 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' dragAction #dragMotion callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragActionDragMotion :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragMotionCallback) -> m SignalHandlerId
afterDragActionDragMotion :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragMotionCallback)
-> m SignalHandlerId
afterDragActionDragMotion a
obj (?self::a) => DragActionDragMotionCallback
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 wrapped :: a -> DragActionDragMotionCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragMotionCallback
DragActionDragMotionCallback
cb
    let wrapped' :: C_DragActionDragMotionCallback
wrapped' = (a -> DragActionDragMotionCallback)
-> C_DragActionDragMotionCallback
forall a.
GObject a =>
(a -> DragActionDragMotionCallback)
-> C_DragActionDragMotionCallback
wrap_DragActionDragMotionCallback a -> DragActionDragMotionCallback
wrapped
    FunPtr C_DragActionDragMotionCallback
wrapped'' <- C_DragActionDragMotionCallback
-> IO (FunPtr C_DragActionDragMotionCallback)
mk_DragActionDragMotionCallback C_DragActionDragMotionCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragMotionCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-motion" FunPtr C_DragActionDragMotionCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragActionDragMotionSignalInfo
instance SignalInfo DragActionDragMotionSignalInfo where
    type HaskellCallbackType DragActionDragMotionSignalInfo = DragActionDragMotionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragActionDragMotionCallback cb
        cb'' <- mk_DragActionDragMotionCallback cb'
        connectSignalFunPtr obj "drag-motion" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction::drag-motion"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:signal:dragMotion"})

#endif

-- signal DragAction::drag-progress
-- | The [dragProgress](#g:signal:dragProgress) signal is emitted for each motion event after
-- the [dragBegin]("GI.Clutter.Objects.DragAction#g:signal:dragBegin") signal has been emitted.
-- 
-- The components of the distance between the press event and the
-- latest motion event are computed in the actor\'s coordinate space,
-- to take into account eventual transformations. If you want the
-- stage coordinates of the latest motion event you can use
-- 'GI.Clutter.Objects.DragAction.dragActionGetMotionCoords'.
-- 
-- The default handler will emit [dragMotion]("GI.Clutter.Objects.DragAction#g:signal:dragMotion"),
-- if [dragProgress]("GI.Clutter.Objects.DragAction#g:signal:dragProgress") emission returns 'P.True'.
-- 
-- /Since: 1.12/
type DragActionDragProgressCallback =
    Clutter.Actor.Actor
    -- ^ /@actor@/: the t'GI.Clutter.Objects.Actor.Actor' attached to the action
    -> Float
    -- ^ /@deltaX@/: the X component of the distance between the press event
    --   that began the dragging and the current position of the pointer,
    --   as of the latest motion event
    -> Float
    -- ^ /@deltaY@/: the Y component of the distance between the press event
    --   that began the dragging and the current position of the pointer,
    --   as of the latest motion event
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if the drag should continue, and 'P.False'
    --   if it should be stopped.

type C_DragActionDragProgressCallback =
    Ptr DragAction ->                       -- object
    Ptr Clutter.Actor.Actor ->
    CFloat ->
    CFloat ->
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_DragActionDragProgressCallback :: 
    GObject a => (a -> DragActionDragProgressCallback) ->
    C_DragActionDragProgressCallback
wrap_DragActionDragProgressCallback :: forall a.
GObject a =>
(a -> DragActionDragProgressCallback)
-> C_DragActionDragProgressCallback
wrap_DragActionDragProgressCallback a -> DragActionDragProgressCallback
gi'cb Ptr DragAction
gi'selfPtr Ptr Actor
actor CFloat
deltaX CFloat
deltaY Ptr ()
_ = do
    Actor
actor' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
actor
    let deltaX' :: Float
deltaX' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
deltaX
    let deltaY' :: Float
deltaY' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
deltaY
    Bool
result <- Ptr DragAction -> (DragAction -> IO Bool) -> IO Bool
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr DragAction
gi'selfPtr ((DragAction -> IO Bool) -> IO Bool)
-> (DragAction -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \DragAction
gi'self -> a -> DragActionDragProgressCallback
gi'cb (DragAction -> a
Coerce.coerce DragAction
gi'self)  Actor
actor' Float
deltaX' Float
deltaY'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [dragProgress](#signal:dragProgress) 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' dragAction #dragProgress callback
-- @
-- 
-- 
onDragActionDragProgress :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragProgressCallback) -> m SignalHandlerId
onDragActionDragProgress :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragProgressCallback)
-> m SignalHandlerId
onDragActionDragProgress a
obj (?self::a) => DragActionDragProgressCallback
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 wrapped :: a -> DragActionDragProgressCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragProgressCallback
DragActionDragProgressCallback
cb
    let wrapped' :: C_DragActionDragProgressCallback
wrapped' = (a -> DragActionDragProgressCallback)
-> C_DragActionDragProgressCallback
forall a.
GObject a =>
(a -> DragActionDragProgressCallback)
-> C_DragActionDragProgressCallback
wrap_DragActionDragProgressCallback a -> DragActionDragProgressCallback
wrapped
    FunPtr C_DragActionDragProgressCallback
wrapped'' <- C_DragActionDragProgressCallback
-> IO (FunPtr C_DragActionDragProgressCallback)
mk_DragActionDragProgressCallback C_DragActionDragProgressCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragProgressCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-progress" FunPtr C_DragActionDragProgressCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dragProgress](#signal:dragProgress) 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' dragAction #dragProgress callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDragActionDragProgress :: (IsDragAction a, MonadIO m) => a -> ((?self :: a) => DragActionDragProgressCallback) -> m SignalHandlerId
afterDragActionDragProgress :: forall a (m :: * -> *).
(IsDragAction a, MonadIO m) =>
a
-> ((?self::a) => DragActionDragProgressCallback)
-> m SignalHandlerId
afterDragActionDragProgress a
obj (?self::a) => DragActionDragProgressCallback
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 wrapped :: a -> DragActionDragProgressCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DragActionDragProgressCallback
DragActionDragProgressCallback
cb
    let wrapped' :: C_DragActionDragProgressCallback
wrapped' = (a -> DragActionDragProgressCallback)
-> C_DragActionDragProgressCallback
forall a.
GObject a =>
(a -> DragActionDragProgressCallback)
-> C_DragActionDragProgressCallback
wrap_DragActionDragProgressCallback a -> DragActionDragProgressCallback
wrapped
    FunPtr C_DragActionDragProgressCallback
wrapped'' <- C_DragActionDragProgressCallback
-> IO (FunPtr C_DragActionDragProgressCallback)
mk_DragActionDragProgressCallback C_DragActionDragProgressCallback
wrapped'
    a
-> Text
-> FunPtr C_DragActionDragProgressCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drag-progress" FunPtr C_DragActionDragProgressCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragActionDragProgressSignalInfo
instance SignalInfo DragActionDragProgressSignalInfo where
    type HaskellCallbackType DragActionDragProgressSignalInfo = DragActionDragProgressCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragActionDragProgressCallback cb
        cb'' <- mk_DragActionDragProgressCallback cb'
        connectSignalFunPtr obj "drag-progress" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction::drag-progress"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:signal:dragProgress"})

#endif

-- VVV Prop "drag-area"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Rect"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just True)

-- | Get the value of the “@drag-area@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dragAction #dragArea
-- @
getDragActionDragArea :: (MonadIO m, IsDragAction o) => o -> m (Maybe Clutter.Rect.Rect)
getDragActionDragArea :: forall (m :: * -> *) o.
(MonadIO m, IsDragAction o) =>
o -> m (Maybe Rect)
getDragActionDragArea o
obj = IO (Maybe Rect) -> m (Maybe Rect)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Rect) -> m (Maybe Rect))
-> IO (Maybe Rect) -> m (Maybe Rect)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Rect -> Rect) -> IO (Maybe Rect)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"drag-area" ManagedPtr Rect -> Rect
Clutter.Rect.Rect

-- | Set the value of the “@drag-area@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragAction [ #dragArea 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragActionDragArea :: (MonadIO m, IsDragAction o) => o -> Clutter.Rect.Rect -> m ()
setDragActionDragArea :: forall (m :: * -> *) o.
(MonadIO m, IsDragAction o) =>
o -> Rect -> m ()
setDragActionDragArea o
obj Rect
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 Rect -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"drag-area" (Rect -> Maybe Rect
forall a. a -> Maybe a
Just Rect
val)

-- | Construct a `GValueConstruct` with valid value for the “@drag-area@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragActionDragArea :: (IsDragAction o, MIO.MonadIO m) => Clutter.Rect.Rect -> m (GValueConstruct o)
constructDragActionDragArea :: forall o (m :: * -> *).
(IsDragAction o, MonadIO m) =>
Rect -> m (GValueConstruct o)
constructDragActionDragArea Rect
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 Rect -> IO (GValueConstruct o)
forall a o. GBoxed a => String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed String
"drag-area" (Rect -> Maybe Rect
forall a. a -> Maybe a
P.Just Rect
val)

-- | Set the value of the “@drag-area@” 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' #dragArea
-- @
clearDragActionDragArea :: (MonadIO m, IsDragAction o) => o -> m ()
clearDragActionDragArea :: forall (m :: * -> *) o. (MonadIO m, IsDragAction o) => o -> m ()
clearDragActionDragArea 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 Rect -> IO ()
forall a b.
(GObject a, GBoxed b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyBoxed o
obj String
"drag-area" (Maybe Rect
forall a. Maybe a
Nothing :: Maybe Clutter.Rect.Rect)

#if defined(ENABLE_OVERLOADING)
data DragActionDragAreaPropertyInfo
instance AttrInfo DragActionDragAreaPropertyInfo where
    type AttrAllowedOps DragActionDragAreaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragActionDragAreaPropertyInfo = IsDragAction
    type AttrSetTypeConstraint DragActionDragAreaPropertyInfo = (~) Clutter.Rect.Rect
    type AttrTransferTypeConstraint DragActionDragAreaPropertyInfo = (~) Clutter.Rect.Rect
    type AttrTransferType DragActionDragAreaPropertyInfo = Clutter.Rect.Rect
    type AttrGetType DragActionDragAreaPropertyInfo = (Maybe Clutter.Rect.Rect)
    type AttrLabel DragActionDragAreaPropertyInfo = "drag-area"
    type AttrOrigin DragActionDragAreaPropertyInfo = DragAction
    attrGet = getDragActionDragArea
    attrSet = setDragActionDragArea
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragActionDragArea
    attrClear = clearDragActionDragArea
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragArea"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:attr:dragArea"
        })
#endif

-- VVV Prop "drag-area-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@drag-area-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dragAction #dragAreaSet
-- @
getDragActionDragAreaSet :: (MonadIO m, IsDragAction o) => o -> m Bool
getDragActionDragAreaSet :: forall (m :: * -> *) o. (MonadIO m, IsDragAction o) => o -> m Bool
getDragActionDragAreaSet 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
"drag-area-set"

#if defined(ENABLE_OVERLOADING)
data DragActionDragAreaSetPropertyInfo
instance AttrInfo DragActionDragAreaSetPropertyInfo where
    type AttrAllowedOps DragActionDragAreaSetPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint DragActionDragAreaSetPropertyInfo = IsDragAction
    type AttrSetTypeConstraint DragActionDragAreaSetPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DragActionDragAreaSetPropertyInfo = (~) ()
    type AttrTransferType DragActionDragAreaSetPropertyInfo = ()
    type AttrGetType DragActionDragAreaSetPropertyInfo = Bool
    type AttrLabel DragActionDragAreaSetPropertyInfo = "drag-area-set"
    type AttrOrigin DragActionDragAreaSetPropertyInfo = DragAction
    attrGet = getDragActionDragAreaSet
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragAreaSet"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:attr:dragAreaSet"
        })
#endif

-- VVV Prop "drag-axis"
   -- Type: TInterface (Name {namespace = "Clutter", name = "DragAxis"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@drag-axis@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragAction [ #dragAxis 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragActionDragAxis :: (MonadIO m, IsDragAction o) => o -> Clutter.Enums.DragAxis -> m ()
setDragActionDragAxis :: forall (m :: * -> *) o.
(MonadIO m, IsDragAction o) =>
o -> DragAxis -> m ()
setDragActionDragAxis o
obj DragAxis
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 -> DragAxis -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"drag-axis" DragAxis
val

-- | Construct a `GValueConstruct` with valid value for the “@drag-axis@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragActionDragAxis :: (IsDragAction o, MIO.MonadIO m) => Clutter.Enums.DragAxis -> m (GValueConstruct o)
constructDragActionDragAxis :: forall o (m :: * -> *).
(IsDragAction o, MonadIO m) =>
DragAxis -> m (GValueConstruct o)
constructDragActionDragAxis DragAxis
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 -> DragAxis -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"drag-axis" DragAxis
val

#if defined(ENABLE_OVERLOADING)
data DragActionDragAxisPropertyInfo
instance AttrInfo DragActionDragAxisPropertyInfo where
    type AttrAllowedOps DragActionDragAxisPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DragActionDragAxisPropertyInfo = IsDragAction
    type AttrSetTypeConstraint DragActionDragAxisPropertyInfo = (~) Clutter.Enums.DragAxis
    type AttrTransferTypeConstraint DragActionDragAxisPropertyInfo = (~) Clutter.Enums.DragAxis
    type AttrTransferType DragActionDragAxisPropertyInfo = Clutter.Enums.DragAxis
    type AttrGetType DragActionDragAxisPropertyInfo = Clutter.Enums.DragAxis
    type AttrLabel DragActionDragAxisPropertyInfo = "drag-axis"
    type AttrOrigin DragActionDragAxisPropertyInfo = DragAction
    attrGet = getDragActionDragAxis
    attrSet = setDragActionDragAxis
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragActionDragAxis
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragAxis"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:attr:dragAxis"
        })
#endif

-- VVV Prop "drag-handle"
   -- Type: TInterface (Name {namespace = "Clutter", name = "Actor"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

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

-- | Set the value of the “@drag-handle@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragAction [ #dragHandle 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragActionDragHandle :: (MonadIO m, IsDragAction o, Clutter.Actor.IsActor a) => o -> a -> m ()
setDragActionDragHandle :: forall (m :: * -> *) o a.
(MonadIO m, IsDragAction o, IsActor a) =>
o -> a -> m ()
setDragActionDragHandle 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
"drag-handle" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@drag-handle@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragActionDragHandle :: (IsDragAction o, MIO.MonadIO m, Clutter.Actor.IsActor a) => a -> m (GValueConstruct o)
constructDragActionDragHandle :: forall o (m :: * -> *) a.
(IsDragAction o, MonadIO m, IsActor a) =>
a -> m (GValueConstruct o)
constructDragActionDragHandle 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
"drag-handle" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@drag-handle@” 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' #dragHandle
-- @
clearDragActionDragHandle :: (MonadIO m, IsDragAction o) => o -> m ()
clearDragActionDragHandle :: forall (m :: * -> *) o. (MonadIO m, IsDragAction o) => o -> m ()
clearDragActionDragHandle 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 Actor -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"drag-handle" (Maybe Actor
forall a. Maybe a
Nothing :: Maybe Clutter.Actor.Actor)

#if defined(ENABLE_OVERLOADING)
data DragActionDragHandlePropertyInfo
instance AttrInfo DragActionDragHandlePropertyInfo where
    type AttrAllowedOps DragActionDragHandlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragActionDragHandlePropertyInfo = IsDragAction
    type AttrSetTypeConstraint DragActionDragHandlePropertyInfo = Clutter.Actor.IsActor
    type AttrTransferTypeConstraint DragActionDragHandlePropertyInfo = Clutter.Actor.IsActor
    type AttrTransferType DragActionDragHandlePropertyInfo = Clutter.Actor.Actor
    type AttrGetType DragActionDragHandlePropertyInfo = Clutter.Actor.Actor
    type AttrLabel DragActionDragHandlePropertyInfo = "drag-handle"
    type AttrOrigin DragActionDragHandlePropertyInfo = DragAction
    attrGet = getDragActionDragHandle
    attrSet = setDragActionDragHandle
    attrTransfer _ v = do
        unsafeCastTo Clutter.Actor.Actor v
    attrConstruct = constructDragActionDragHandle
    attrClear = clearDragActionDragHandle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragHandle"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:attr:dragHandle"
        })
#endif

-- VVV Prop "x-drag-threshold"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@x-drag-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dragAction #xDragThreshold
-- @
getDragActionXDragThreshold :: (MonadIO m, IsDragAction o) => o -> m Int32
getDragActionXDragThreshold :: forall (m :: * -> *) o. (MonadIO m, IsDragAction o) => o -> m Int32
getDragActionXDragThreshold o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"x-drag-threshold"

-- | Set the value of the “@x-drag-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragAction [ #xDragThreshold 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragActionXDragThreshold :: (MonadIO m, IsDragAction o) => o -> Int32 -> m ()
setDragActionXDragThreshold :: forall (m :: * -> *) o.
(MonadIO m, IsDragAction o) =>
o -> Int32 -> m ()
setDragActionXDragThreshold o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"x-drag-threshold" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@x-drag-threshold@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragActionXDragThreshold :: (IsDragAction o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDragActionXDragThreshold :: forall o (m :: * -> *).
(IsDragAction o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDragActionXDragThreshold Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"x-drag-threshold" Int32
val

#if defined(ENABLE_OVERLOADING)
data DragActionXDragThresholdPropertyInfo
instance AttrInfo DragActionXDragThresholdPropertyInfo where
    type AttrAllowedOps DragActionXDragThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DragActionXDragThresholdPropertyInfo = IsDragAction
    type AttrSetTypeConstraint DragActionXDragThresholdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DragActionXDragThresholdPropertyInfo = (~) Int32
    type AttrTransferType DragActionXDragThresholdPropertyInfo = Int32
    type AttrGetType DragActionXDragThresholdPropertyInfo = Int32
    type AttrLabel DragActionXDragThresholdPropertyInfo = "x-drag-threshold"
    type AttrOrigin DragActionXDragThresholdPropertyInfo = DragAction
    attrGet = getDragActionXDragThreshold
    attrSet = setDragActionXDragThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragActionXDragThreshold
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.xDragThreshold"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:attr:xDragThreshold"
        })
#endif

-- VVV Prop "y-drag-threshold"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@y-drag-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' dragAction #yDragThreshold
-- @
getDragActionYDragThreshold :: (MonadIO m, IsDragAction o) => o -> m Int32
getDragActionYDragThreshold :: forall (m :: * -> *) o. (MonadIO m, IsDragAction o) => o -> m Int32
getDragActionYDragThreshold o
obj = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"y-drag-threshold"

-- | Set the value of the “@y-drag-threshold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dragAction [ #yDragThreshold 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragActionYDragThreshold :: (MonadIO m, IsDragAction o) => o -> Int32 -> m ()
setDragActionYDragThreshold :: forall (m :: * -> *) o.
(MonadIO m, IsDragAction o) =>
o -> Int32 -> m ()
setDragActionYDragThreshold o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"y-drag-threshold" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@y-drag-threshold@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragActionYDragThreshold :: (IsDragAction o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructDragActionYDragThreshold :: forall o (m :: * -> *).
(IsDragAction o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructDragActionYDragThreshold Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"y-drag-threshold" Int32
val

#if defined(ENABLE_OVERLOADING)
data DragActionYDragThresholdPropertyInfo
instance AttrInfo DragActionYDragThresholdPropertyInfo where
    type AttrAllowedOps DragActionYDragThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DragActionYDragThresholdPropertyInfo = IsDragAction
    type AttrSetTypeConstraint DragActionYDragThresholdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint DragActionYDragThresholdPropertyInfo = (~) Int32
    type AttrTransferType DragActionYDragThresholdPropertyInfo = Int32
    type AttrGetType DragActionYDragThresholdPropertyInfo = Int32
    type AttrLabel DragActionYDragThresholdPropertyInfo = "y-drag-threshold"
    type AttrOrigin DragActionYDragThresholdPropertyInfo = DragAction
    attrGet = getDragActionYDragThreshold
    attrSet = setDragActionYDragThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragActionYDragThreshold
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.yDragThreshold"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#g:attr:yDragThreshold"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DragAction
type instance O.AttributeList DragAction = DragActionAttributeList
type DragActionAttributeList = ('[ '("actor", Clutter.ActorMeta.ActorMetaActorPropertyInfo), '("dragArea", DragActionDragAreaPropertyInfo), '("dragAreaSet", DragActionDragAreaSetPropertyInfo), '("dragAxis", DragActionDragAxisPropertyInfo), '("dragHandle", DragActionDragHandlePropertyInfo), '("enabled", Clutter.ActorMeta.ActorMetaEnabledPropertyInfo), '("name", Clutter.ActorMeta.ActorMetaNamePropertyInfo), '("xDragThreshold", DragActionXDragThresholdPropertyInfo), '("yDragThreshold", DragActionYDragThresholdPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dragActionDragArea :: AttrLabelProxy "dragArea"
dragActionDragArea = AttrLabelProxy

dragActionDragAreaSet :: AttrLabelProxy "dragAreaSet"
dragActionDragAreaSet = AttrLabelProxy

dragActionDragAxis :: AttrLabelProxy "dragAxis"
dragActionDragAxis = AttrLabelProxy

dragActionDragHandle :: AttrLabelProxy "dragHandle"
dragActionDragHandle = AttrLabelProxy

dragActionXDragThreshold :: AttrLabelProxy "xDragThreshold"
dragActionXDragThreshold = AttrLabelProxy

dragActionYDragThreshold :: AttrLabelProxy "yDragThreshold"
dragActionYDragThreshold = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DragAction = DragActionSignalList
type DragActionSignalList = ('[ '("dragBegin", DragActionDragBeginSignalInfo), '("dragEnd", DragActionDragEndSignalInfo), '("dragMotion", DragActionDragMotionSignalInfo), '("dragProgress", DragActionDragProgressSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method DragAction::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "DragAction" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_new" clutter_drag_action_new :: 
    IO (Ptr DragAction)

-- | Creates a new t'GI.Clutter.Objects.DragAction.DragAction' instance
-- 
-- /Since: 1.4/
dragActionNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m DragAction
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.DragAction.DragAction'
dragActionNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m DragAction
dragActionNew  = IO DragAction -> m DragAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DragAction -> m DragAction) -> IO DragAction -> m DragAction
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
result <- IO (Ptr DragAction)
clutter_drag_action_new
    Text -> Ptr DragAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragActionNew" Ptr DragAction
result
    DragAction
result' <- ((ManagedPtr DragAction -> DragAction)
-> Ptr DragAction -> IO DragAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr DragAction -> DragAction
DragAction) Ptr DragAction
result
    DragAction -> IO DragAction
forall (m :: * -> *) a. Monad m => a -> m a
return DragAction
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DragAction::get_drag_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "drag_area"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect to be filled"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_get_drag_area" clutter_drag_action_get_drag_area :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Ptr Clutter.Rect.Rect ->                -- drag_area : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO CInt

-- | Retrieves the \"drag area\" associated with /@action@/, that
-- is a t'GI.Clutter.Structs.Rect.Rect' that constrains the actor movements,
-- in parents coordinates.
dragActionGetDragArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> m ((Bool, Clutter.Rect.Rect))
    -- ^ __Returns:__ 'P.True' if the actor is actually constrained (and thus
    --          /@dragArea@/ is valid), 'P.False' otherwise
dragActionGetDragArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> m (Bool, Rect)
dragActionGetDragArea a
action = IO (Bool, Rect) -> m (Bool, Rect)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Rect) -> m (Bool, Rect))
-> IO (Bool, Rect) -> m (Bool, Rect)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Rect
dragArea <- Int -> IO (Ptr Rect)
forall a. GBoxed a => Int -> IO (Ptr a)
SP.callocBoxedBytes Int
16 :: IO (Ptr Clutter.Rect.Rect)
    CInt
result <- Ptr DragAction -> Ptr Rect -> IO CInt
clutter_drag_action_get_drag_area Ptr DragAction
action' Ptr Rect
dragArea
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Rect
dragArea' <- ((ManagedPtr Rect -> Rect) -> Ptr Rect -> IO Rect
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Rect -> Rect
Clutter.Rect.Rect) Ptr Rect
dragArea
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    (Bool, Rect) -> IO (Bool, Rect)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Rect
dragArea')

#if defined(ENABLE_OVERLOADING)
data DragActionGetDragAreaMethodInfo
instance (signature ~ (m ((Bool, Clutter.Rect.Rect))), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionGetDragAreaMethodInfo a signature where
    overloadedMethod = dragActionGetDragArea

instance O.OverloadedMethodInfo DragActionGetDragAreaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionGetDragArea",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionGetDragArea"
        })


#endif

-- method DragAction::get_drag_axis
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "DragAxis" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_get_drag_axis" clutter_drag_action_get_drag_axis :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    IO CUInt

-- | Retrieves the axis constraint set by 'GI.Clutter.Objects.DragAction.dragActionSetDragAxis'
-- 
-- /Since: 1.4/
dragActionGetDragAxis ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> m Clutter.Enums.DragAxis
    -- ^ __Returns:__ the axis constraint
dragActionGetDragAxis :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> m DragAxis
dragActionGetDragAxis a
action = IO DragAxis -> m DragAxis
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DragAxis -> m DragAxis) -> IO DragAxis -> m DragAxis
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    CUInt
result <- Ptr DragAction -> IO CUInt
clutter_drag_action_get_drag_axis Ptr DragAction
action'
    let result' :: DragAxis
result' = (Int -> DragAxis
forall a. Enum a => Int -> a
toEnum (Int -> DragAxis) -> (CUInt -> Int) -> CUInt -> DragAxis
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
action
    DragAxis -> IO DragAxis
forall (m :: * -> *) a. Monad m => a -> m a
return DragAxis
result'

#if defined(ENABLE_OVERLOADING)
data DragActionGetDragAxisMethodInfo
instance (signature ~ (m Clutter.Enums.DragAxis), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionGetDragAxisMethodInfo a signature where
    overloadedMethod = dragActionGetDragAxis

instance O.OverloadedMethodInfo DragActionGetDragAxisMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionGetDragAxis",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionGetDragAxis"
        })


#endif

-- method DragAction::get_drag_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Clutter" , name = "Actor" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_get_drag_handle" clutter_drag_action_get_drag_handle :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    IO (Ptr Clutter.Actor.Actor)

-- | Retrieves the drag handle set by 'GI.Clutter.Objects.DragAction.dragActionSetDragHandle'
-- 
-- /Since: 1.4/
dragActionGetDragHandle ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> m Clutter.Actor.Actor
    -- ^ __Returns:__ a t'GI.Clutter.Objects.Actor.Actor', used as the drag
    --   handle, or 'P.Nothing' if none was set
dragActionGetDragHandle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> m Actor
dragActionGetDragHandle a
action = IO Actor -> m Actor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Actor -> m Actor) -> IO Actor -> m Actor
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Actor
result <- Ptr DragAction -> IO (Ptr Actor)
clutter_drag_action_get_drag_handle Ptr DragAction
action'
    Text -> Ptr Actor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragActionGetDragHandle" Ptr Actor
result
    Actor
result' <- ((ManagedPtr Actor -> Actor) -> Ptr Actor -> IO Actor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Actor -> Actor
Clutter.Actor.Actor) Ptr Actor
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Actor -> IO Actor
forall (m :: * -> *) a. Monad m => a -> m a
return Actor
result'

#if defined(ENABLE_OVERLOADING)
data DragActionGetDragHandleMethodInfo
instance (signature ~ (m Clutter.Actor.Actor), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionGetDragHandleMethodInfo a signature where
    overloadedMethod = dragActionGetDragHandle

instance O.OverloadedMethodInfo DragActionGetDragHandleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionGetDragHandle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionGetDragHandle"
        })


#endif

-- method DragAction::get_drag_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_threshold"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the horizontal drag\n  threshold value, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "y_threshold"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the vertical drag\n  threshold value, in pixels"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_get_drag_threshold" clutter_drag_action_get_drag_threshold :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Ptr Word32 ->                           -- x_threshold : TBasicType TUInt
    Ptr Word32 ->                           -- y_threshold : TBasicType TUInt
    IO ()

-- | Retrieves the values set by 'GI.Clutter.Objects.DragAction.dragActionSetDragThreshold'.
-- 
-- If the t'GI.Clutter.Objects.DragAction.DragAction':@/x-drag-threshold/@ property or the
-- t'GI.Clutter.Objects.DragAction.DragAction':@/y-drag-threshold/@ property have been set to -1 then
-- this function will return the default drag threshold value as stored
-- by the t'GI.Clutter.Objects.Settings.Settings':@/dnd-drag-threshold/@ property of t'GI.Clutter.Objects.Settings.Settings'.
-- 
-- /Since: 1.4/
dragActionGetDragThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> m ((Word32, Word32))
dragActionGetDragThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> m (Word32, Word32)
dragActionGetDragThreshold a
action = IO (Word32, Word32) -> m (Word32, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word32) -> m (Word32, Word32))
-> IO (Word32, Word32) -> m (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Word32
xThreshold <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr Word32
yThreshold <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr DragAction -> Ptr Word32 -> Ptr Word32 -> IO ()
clutter_drag_action_get_drag_threshold Ptr DragAction
action' Ptr Word32
xThreshold Ptr Word32
yThreshold
    Word32
xThreshold' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
xThreshold
    Word32
yThreshold' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
yThreshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
xThreshold
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
yThreshold
    (Word32, Word32) -> IO (Word32, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
xThreshold', Word32
yThreshold')

#if defined(ENABLE_OVERLOADING)
data DragActionGetDragThresholdMethodInfo
instance (signature ~ (m ((Word32, Word32))), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionGetDragThresholdMethodInfo a signature where
    overloadedMethod = dragActionGetDragThreshold

instance O.OverloadedMethodInfo DragActionGetDragThresholdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionGetDragThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionGetDragThreshold"
        })


#endif

-- method DragAction::get_motion_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "motion_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the latest motion\n  event's X coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "motion_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the latest motion\n  event's Y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_get_motion_coords" clutter_drag_action_get_motion_coords :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Ptr CFloat ->                           -- motion_x : TBasicType TFloat
    Ptr CFloat ->                           -- motion_y : TBasicType TFloat
    IO ()

-- | Retrieves the coordinates, in stage space, of the latest motion
-- event during the dragging
-- 
-- /Since: 1.4/
dragActionGetMotionCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> m ((Float, Float))
dragActionGetMotionCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> m (Float, Float)
dragActionGetMotionCoords a
action = IO (Float, Float) -> m (Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
motionX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
motionY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr DragAction -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_drag_action_get_motion_coords Ptr DragAction
action' Ptr CFloat
motionX Ptr CFloat
motionY
    CFloat
motionX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
motionX
    let motionX'' :: Float
motionX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
motionX'
    CFloat
motionY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
motionY
    let motionY'' :: Float
motionY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
motionY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
motionX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
motionY
    (Float, Float) -> IO (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
motionX'', Float
motionY'')

#if defined(ENABLE_OVERLOADING)
data DragActionGetMotionCoordsMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionGetMotionCoordsMethodInfo a signature where
    overloadedMethod = dragActionGetMotionCoords

instance O.OverloadedMethodInfo DragActionGetMotionCoordsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionGetMotionCoords",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionGetMotionCoords"
        })


#endif

-- method DragAction::get_press_coords
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "press_x"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the press event's X coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "press_y"
--           , argType = TBasicType TFloat
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for the press event's Y coordinate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_get_press_coords" clutter_drag_action_get_press_coords :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Ptr CFloat ->                           -- press_x : TBasicType TFloat
    Ptr CFloat ->                           -- press_y : TBasicType TFloat
    IO ()

-- | Retrieves the coordinates, in stage space, of the press event
-- that started the dragging
-- 
-- /Since: 1.4/
dragActionGetPressCoords ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> m ((Float, Float))
dragActionGetPressCoords :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> m (Float, Float)
dragActionGetPressCoords a
action = IO (Float, Float) -> m (Float, Float)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Float, Float) -> m (Float, Float))
-> IO (Float, Float) -> m (Float, Float)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr CFloat
pressX <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr CFloat
pressY <- IO (Ptr CFloat)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CFloat)
    Ptr DragAction -> Ptr CFloat -> Ptr CFloat -> IO ()
clutter_drag_action_get_press_coords Ptr DragAction
action' Ptr CFloat
pressX Ptr CFloat
pressY
    CFloat
pressX' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
pressX
    let pressX'' :: Float
pressX'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
pressX'
    CFloat
pressY' <- Ptr CFloat -> IO CFloat
forall a. Storable a => Ptr a -> IO a
peek Ptr CFloat
pressY
    let pressY'' :: Float
pressY'' = CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
pressY'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
pressX
    Ptr CFloat -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CFloat
pressY
    (Float, Float) -> IO (Float, Float)
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
pressX'', Float
pressY'')

#if defined(ENABLE_OVERLOADING)
data DragActionGetPressCoordsMethodInfo
instance (signature ~ (m ((Float, Float))), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionGetPressCoordsMethodInfo a signature where
    overloadedMethod = dragActionGetPressCoords

instance O.OverloadedMethodInfo DragActionGetPressCoordsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionGetPressCoords",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionGetPressCoords"
        })


#endif

-- method DragAction::set_drag_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "drag_area"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Rect" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterRect" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_set_drag_area" clutter_drag_action_set_drag_area :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Ptr Clutter.Rect.Rect ->                -- drag_area : TInterface (Name {namespace = "Clutter", name = "Rect"})
    IO ()

-- | Sets /@dragArea@/ to constrain the dragging of the actor associated
-- with /@action@/, so that it position is always within /@dragArea@/, expressed
-- in parent\'s coordinates.
-- If /@dragArea@/ is 'P.Nothing', the actor is not constrained.
dragActionSetDragArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> Maybe (Clutter.Rect.Rect)
    -- ^ /@dragArea@/: a t'GI.Clutter.Structs.Rect.Rect'
    -> m ()
dragActionSetDragArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> Maybe Rect -> m ()
dragActionSetDragArea a
action Maybe Rect
dragArea = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Rect
maybeDragArea <- case Maybe Rect
dragArea of
        Maybe Rect
Nothing -> Ptr Rect -> IO (Ptr Rect)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Rect
forall a. Ptr a
nullPtr
        Just Rect
jDragArea -> do
            Ptr Rect
jDragArea' <- Rect -> IO (Ptr Rect)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Rect
jDragArea
            Ptr Rect -> IO (Ptr Rect)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Rect
jDragArea'
    Ptr DragAction -> Ptr Rect -> IO ()
clutter_drag_action_set_drag_area Ptr DragAction
action' Ptr Rect
maybeDragArea
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Maybe Rect -> (Rect -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Rect
dragArea Rect -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragActionSetDragAreaMethodInfo
instance (signature ~ (Maybe (Clutter.Rect.Rect) -> m ()), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionSetDragAreaMethodInfo a signature where
    overloadedMethod = dragActionSetDragArea

instance O.OverloadedMethodInfo DragActionSetDragAreaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionSetDragArea",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionSetDragArea"
        })


#endif

-- method DragAction::set_drag_axis
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "axis"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAxis" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the axis to constraint the dragging to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_set_drag_axis" clutter_drag_action_set_drag_axis :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    CUInt ->                                -- axis : TInterface (Name {namespace = "Clutter", name = "DragAxis"})
    IO ()

-- | Restricts the dragging action to a specific axis
-- 
-- /Since: 1.4/
dragActionSetDragAxis ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> Clutter.Enums.DragAxis
    -- ^ /@axis@/: the axis to constraint the dragging to
    -> m ()
dragActionSetDragAxis :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> DragAxis -> m ()
dragActionSetDragAxis a
action DragAxis
axis = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    let axis' :: CUInt
axis' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (DragAxis -> Int) -> DragAxis -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DragAxis -> Int
forall a. Enum a => a -> Int
fromEnum) DragAxis
axis
    Ptr DragAction -> CUInt -> IO ()
clutter_drag_action_set_drag_axis Ptr DragAction
action' CUInt
axis'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragActionSetDragAxisMethodInfo
instance (signature ~ (Clutter.Enums.DragAxis -> m ()), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionSetDragAxisMethodInfo a signature where
    overloadedMethod = dragActionSetDragAxis

instance O.OverloadedMethodInfo DragActionSetDragAxisMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionSetDragAxis",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionSetDragAxis"
        })


#endif

-- method DragAction::set_drag_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handle"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Actor" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterActor, or %NULL to unset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_set_drag_handle" clutter_drag_action_set_drag_handle :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Ptr Clutter.Actor.Actor ->              -- handle : TInterface (Name {namespace = "Clutter", name = "Actor"})
    IO ()

-- | Sets the actor to be used as the drag handle.
-- 
-- /Since: 1.4/
dragActionSetDragHandle ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a, Clutter.Actor.IsActor b) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> Maybe (b)
    -- ^ /@handle@/: a t'GI.Clutter.Objects.Actor.Actor', or 'P.Nothing' to unset
    -> m ()
dragActionSetDragHandle :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDragAction a, IsActor b) =>
a -> Maybe b -> m ()
dragActionSetDragHandle a
action Maybe b
handle = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr Actor
maybeHandle <- case Maybe b
handle of
        Maybe b
Nothing -> Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
forall a. Ptr a
nullPtr
        Just b
jHandle -> do
            Ptr Actor
jHandle' <- b -> IO (Ptr Actor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jHandle
            Ptr Actor -> IO (Ptr Actor)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Actor
jHandle'
    Ptr DragAction -> Ptr Actor -> IO ()
clutter_drag_action_set_drag_handle Ptr DragAction
action' Ptr Actor
maybeHandle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
handle b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragActionSetDragHandleMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsDragAction a, Clutter.Actor.IsActor b) => O.OverloadedMethod DragActionSetDragHandleMethodInfo a signature where
    overloadedMethod = dragActionSetDragHandle

instance O.OverloadedMethodInfo DragActionSetDragHandleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionSetDragHandle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionSetDragHandle"
        })


#endif

-- method DragAction::set_drag_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterDragAction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x_threshold"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a distance on the horizontal axis, in pixels, or\n  -1 to use the default drag threshold from #ClutterSettings"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y_threshold"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a distance on the vertical axis, in pixels, or\n  -1 to use the default drag threshold from #ClutterSettings"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_drag_action_set_drag_threshold" clutter_drag_action_set_drag_threshold :: 
    Ptr DragAction ->                       -- action : TInterface (Name {namespace = "Clutter", name = "DragAction"})
    Int32 ->                                -- x_threshold : TBasicType TInt
    Int32 ->                                -- y_threshold : TBasicType TInt
    IO ()

-- | Sets the horizontal and vertical drag thresholds that must be
-- cleared by the pointer before /@action@/ can begin the dragging.
-- 
-- If /@xThreshold@/ or /@yThreshold@/ are set to -1 then the default
-- drag threshold stored in the t'GI.Clutter.Objects.Settings.Settings':@/dnd-drag-threshold/@
-- property of t'GI.Clutter.Objects.Settings.Settings' will be used.
-- 
-- /Since: 1.4/
dragActionSetDragThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsDragAction a) =>
    a
    -- ^ /@action@/: a t'GI.Clutter.Objects.DragAction.DragAction'
    -> Int32
    -- ^ /@xThreshold@/: a distance on the horizontal axis, in pixels, or
    --   -1 to use the default drag threshold from t'GI.Clutter.Objects.Settings.Settings'
    -> Int32
    -- ^ /@yThreshold@/: a distance on the vertical axis, in pixels, or
    --   -1 to use the default drag threshold from t'GI.Clutter.Objects.Settings.Settings'
    -> m ()
dragActionSetDragThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDragAction a) =>
a -> Int32 -> Int32 -> m ()
dragActionSetDragThreshold a
action Int32
xThreshold Int32
yThreshold = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DragAction
action' <- a -> IO (Ptr DragAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
action
    Ptr DragAction -> Int32 -> Int32 -> IO ()
clutter_drag_action_set_drag_threshold Ptr DragAction
action' Int32
xThreshold Int32
yThreshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
action
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragActionSetDragThresholdMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsDragAction a) => O.OverloadedMethod DragActionSetDragThresholdMethodInfo a signature where
    overloadedMethod = dragActionSetDragThreshold

instance O.OverloadedMethodInfo DragActionSetDragThresholdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.DragAction.dragActionSetDragThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.2/docs/GI-Clutter-Objects-DragAction.html#v:dragActionSetDragThreshold"
        })


#endif