{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The GdkDrag struct contains only private fields and
-- should not be accessed directly.

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

module GI.Gdk.Objects.Drag
    ( 

-- * Exported types
    Drag(..)                                ,
    IsDrag                                  ,
    toDrag                                  ,


 -- * 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"), [dropDone]("GI.Gdk.Objects.Drag#g:method:dropDone"), [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
-- [getActions]("GI.Gdk.Objects.Drag#g:method:getActions"), [getContent]("GI.Gdk.Objects.Drag#g:method:getContent"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDevice]("GI.Gdk.Objects.Drag#g:method:getDevice"), [getDisplay]("GI.Gdk.Objects.Drag#g:method:getDisplay"), [getDragSurface]("GI.Gdk.Objects.Drag#g:method:getDragSurface"), [getFormats]("GI.Gdk.Objects.Drag#g:method:getFormats"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSelectedAction]("GI.Gdk.Objects.Drag#g:method:getSelectedAction"), [getSurface]("GI.Gdk.Objects.Drag#g:method:getSurface").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setHotspot]("GI.Gdk.Objects.Drag#g:method:setHotspot"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDragMethod                       ,
#endif

-- ** begin #method:begin#

    dragBegin                               ,


-- ** dropDone #method:dropDone#

#if defined(ENABLE_OVERLOADING)
    DragDropDoneMethodInfo                  ,
#endif
    dragDropDone                            ,


-- ** getActions #method:getActions#

#if defined(ENABLE_OVERLOADING)
    DragGetActionsMethodInfo                ,
#endif
    dragGetActions                          ,


-- ** getContent #method:getContent#

#if defined(ENABLE_OVERLOADING)
    DragGetContentMethodInfo                ,
#endif
    dragGetContent                          ,


-- ** getDevice #method:getDevice#

#if defined(ENABLE_OVERLOADING)
    DragGetDeviceMethodInfo                 ,
#endif
    dragGetDevice                           ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    DragGetDisplayMethodInfo                ,
#endif
    dragGetDisplay                          ,


-- ** getDragSurface #method:getDragSurface#

#if defined(ENABLE_OVERLOADING)
    DragGetDragSurfaceMethodInfo            ,
#endif
    dragGetDragSurface                      ,


-- ** getFormats #method:getFormats#

#if defined(ENABLE_OVERLOADING)
    DragGetFormatsMethodInfo                ,
#endif
    dragGetFormats                          ,


-- ** getSelectedAction #method:getSelectedAction#

#if defined(ENABLE_OVERLOADING)
    DragGetSelectedActionMethodInfo         ,
#endif
    dragGetSelectedAction                   ,


-- ** getSurface #method:getSurface#

#if defined(ENABLE_OVERLOADING)
    DragGetSurfaceMethodInfo                ,
#endif
    dragGetSurface                          ,


-- ** setHotspot #method:setHotspot#

#if defined(ENABLE_OVERLOADING)
    DragSetHotspotMethodInfo                ,
#endif
    dragSetHotspot                          ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    DragActionsPropertyInfo                 ,
#endif
    constructDragActions                    ,
#if defined(ENABLE_OVERLOADING)
    dragActions                             ,
#endif
    getDragActions                          ,
    setDragActions                          ,


-- ** content #attr:content#
-- | The t'GI.Gdk.Objects.ContentProvider.ContentProvider'.

#if defined(ENABLE_OVERLOADING)
    DragContentPropertyInfo                 ,
#endif
    constructDragContent                    ,
#if defined(ENABLE_OVERLOADING)
    dragContent                             ,
#endif
    getDragContent                          ,


-- ** device #attr:device#
-- | The t'GI.Gdk.Objects.Device.Device' that is performing the drag.

#if defined(ENABLE_OVERLOADING)
    DragDevicePropertyInfo                  ,
#endif
    constructDragDevice                     ,
#if defined(ENABLE_OVERLOADING)
    dragDevice                              ,
#endif
    getDragDevice                           ,


-- ** display #attr:display#
-- | The t'GI.Gdk.Objects.Display.Display' that the drag belongs to.

#if defined(ENABLE_OVERLOADING)
    DragDisplayPropertyInfo                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    dragDisplay                             ,
#endif
    getDragDisplay                          ,


-- ** formats #attr:formats#
-- | The possible formats that the drag can provide its data in.

#if defined(ENABLE_OVERLOADING)
    DragFormatsPropertyInfo                 ,
#endif
    constructDragFormats                    ,
#if defined(ENABLE_OVERLOADING)
    dragFormats                             ,
#endif
    getDragFormats                          ,


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

#if defined(ENABLE_OVERLOADING)
    DragSelectedActionPropertyInfo          ,
#endif
    constructDragSelectedAction             ,
#if defined(ENABLE_OVERLOADING)
    dragSelectedAction                      ,
#endif
    getDragSelectedAction                   ,
    setDragSelectedAction                   ,


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

#if defined(ENABLE_OVERLOADING)
    DragSurfacePropertyInfo                 ,
#endif
    constructDragSurface                    ,
#if defined(ENABLE_OVERLOADING)
    dragSurface                             ,
#endif
    getDragSurface                          ,




 -- * Signals


-- ** cancel #signal:cancel#

    C_DragCancelCallback                    ,
    DragCancelCallback                      ,
#if defined(ENABLE_OVERLOADING)
    DragCancelSignalInfo                    ,
#endif
    afterDragCancel                         ,
    genClosure_DragCancel                   ,
    mk_DragCancelCallback                   ,
    noDragCancelCallback                    ,
    onDragCancel                            ,
    wrap_DragCancelCallback                 ,


-- ** dndFinished #signal:dndFinished#

    C_DragDndFinishedCallback               ,
    DragDndFinishedCallback                 ,
#if defined(ENABLE_OVERLOADING)
    DragDndFinishedSignalInfo               ,
#endif
    afterDragDndFinished                    ,
    genClosure_DragDndFinished              ,
    mk_DragDndFinishedCallback              ,
    noDragDndFinishedCallback               ,
    onDragDndFinished                       ,
    wrap_DragDndFinishedCallback            ,


-- ** dropPerformed #signal:dropPerformed#

    C_DragDropPerformedCallback             ,
    DragDropPerformedCallback               ,
#if defined(ENABLE_OVERLOADING)
    DragDropPerformedSignalInfo             ,
#endif
    afterDragDropPerformed                  ,
    genClosure_DragDropPerformed            ,
    mk_DragDropPerformedCallback            ,
    noDragDropPerformedCallback             ,
    onDragDropPerformed                     ,
    wrap_DragDropPerformedCallback          ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats

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

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

foreign import ccall "gdk_drag_get_type"
    c_gdk_drag_get_type :: IO B.Types.GType

instance B.Types.TypedObject Drag where
    glibType :: IO GType
glibType = IO GType
c_gdk_drag_get_type

instance B.Types.GObject Drag

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDragMethod (t :: Symbol) (o :: *) :: * where
    ResolveDragMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDragMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDragMethod "dropDone" o = DragDropDoneMethodInfo
    ResolveDragMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDragMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDragMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDragMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDragMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDragMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDragMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDragMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDragMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDragMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDragMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDragMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDragMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDragMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDragMethod "getActions" o = DragGetActionsMethodInfo
    ResolveDragMethod "getContent" o = DragGetContentMethodInfo
    ResolveDragMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDragMethod "getDevice" o = DragGetDeviceMethodInfo
    ResolveDragMethod "getDisplay" o = DragGetDisplayMethodInfo
    ResolveDragMethod "getDragSurface" o = DragGetDragSurfaceMethodInfo
    ResolveDragMethod "getFormats" o = DragGetFormatsMethodInfo
    ResolveDragMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDragMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDragMethod "getSelectedAction" o = DragGetSelectedActionMethodInfo
    ResolveDragMethod "getSurface" o = DragGetSurfaceMethodInfo
    ResolveDragMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDragMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDragMethod "setHotspot" o = DragSetHotspotMethodInfo
    ResolveDragMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDragMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Drag::cancel
-- | The drag operation was cancelled.
type DragCancelCallback =
    Gdk.Enums.DragCancelReason
    -- ^ /@reason@/: The reason the drag was cancelled
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `DragCancelCallback`@.
noDragCancelCallback :: Maybe DragCancelCallback
noDragCancelCallback :: Maybe DragCancelCallback
noDragCancelCallback = Maybe DragCancelCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DragCancel :: MonadIO m => DragCancelCallback -> m (GClosure C_DragCancelCallback)
genClosure_DragCancel :: forall (m :: * -> *).
MonadIO m =>
DragCancelCallback -> m (GClosure C_DragCancelCallback)
genClosure_DragCancel DragCancelCallback
cb = IO (GClosure C_DragCancelCallback)
-> m (GClosure C_DragCancelCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DragCancelCallback)
 -> m (GClosure C_DragCancelCallback))
-> IO (GClosure C_DragCancelCallback)
-> m (GClosure C_DragCancelCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragCancelCallback
cb' = DragCancelCallback -> C_DragCancelCallback
wrap_DragCancelCallback DragCancelCallback
cb
    C_DragCancelCallback -> IO (FunPtr C_DragCancelCallback)
mk_DragCancelCallback C_DragCancelCallback
cb' IO (FunPtr C_DragCancelCallback)
-> (FunPtr C_DragCancelCallback
    -> IO (GClosure C_DragCancelCallback))
-> IO (GClosure C_DragCancelCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DragCancelCallback -> IO (GClosure C_DragCancelCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DragCancelCallback` into a `C_DragCancelCallback`.
wrap_DragCancelCallback ::
    DragCancelCallback ->
    C_DragCancelCallback
wrap_DragCancelCallback :: DragCancelCallback -> C_DragCancelCallback
wrap_DragCancelCallback DragCancelCallback
_cb Ptr ()
_ CUInt
reason Ptr ()
_ = do
    let reason' :: DragCancelReason
reason' = (Int -> DragCancelReason
forall a. Enum a => Int -> a
toEnum (Int -> DragCancelReason)
-> (CUInt -> Int) -> CUInt -> DragCancelReason
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
reason
    DragCancelCallback
_cb  DragCancelReason
reason'


-- | Connect a signal handler for the [cancel](#signal:cancel) 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' drag #cancel callback
-- @
-- 
-- 
onDragCancel :: (IsDrag a, MonadIO m) => a -> DragCancelCallback -> m SignalHandlerId
onDragCancel :: forall a (m :: * -> *).
(IsDrag a, MonadIO m) =>
a -> DragCancelCallback -> m SignalHandlerId
onDragCancel a
obj DragCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragCancelCallback
cb' = DragCancelCallback -> C_DragCancelCallback
wrap_DragCancelCallback DragCancelCallback
cb
    FunPtr C_DragCancelCallback
cb'' <- C_DragCancelCallback -> IO (FunPtr C_DragCancelCallback)
mk_DragCancelCallback C_DragCancelCallback
cb'
    a
-> Text
-> FunPtr C_DragCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"cancel" FunPtr C_DragCancelCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cancel](#signal:cancel) 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' drag #cancel callback
-- @
-- 
-- 
afterDragCancel :: (IsDrag a, MonadIO m) => a -> DragCancelCallback -> m SignalHandlerId
afterDragCancel :: forall a (m :: * -> *).
(IsDrag a, MonadIO m) =>
a -> DragCancelCallback -> m SignalHandlerId
afterDragCancel a
obj DragCancelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragCancelCallback
cb' = DragCancelCallback -> C_DragCancelCallback
wrap_DragCancelCallback DragCancelCallback
cb
    FunPtr C_DragCancelCallback
cb'' <- C_DragCancelCallback -> IO (FunPtr C_DragCancelCallback)
mk_DragCancelCallback C_DragCancelCallback
cb'
    a
-> Text
-> FunPtr C_DragCancelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"cancel" FunPtr C_DragCancelCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragCancelSignalInfo
instance SignalInfo DragCancelSignalInfo where
    type HaskellCallbackType DragCancelSignalInfo = DragCancelCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragCancelCallback cb
        cb'' <- mk_DragCancelCallback cb'
        connectSignalFunPtr obj "cancel" cb'' connectMode detail

#endif

-- signal Drag::dnd-finished
-- | The drag operation was finished, the destination
-- finished reading all data. The drag object can now
-- free all miscellaneous data.
type DragDndFinishedCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DragDndFinished :: MonadIO m => DragDndFinishedCallback -> m (GClosure C_DragDndFinishedCallback)
genClosure_DragDndFinished :: forall (m :: * -> *).
MonadIO m =>
IO () -> m (GClosure C_DragDndFinishedCallback)
genClosure_DragDndFinished IO ()
cb = IO (GClosure C_DragDndFinishedCallback)
-> m (GClosure C_DragDndFinishedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DragDndFinishedCallback)
 -> m (GClosure C_DragDndFinishedCallback))
-> IO (GClosure C_DragDndFinishedCallback)
-> m (GClosure C_DragDndFinishedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragDndFinishedCallback
cb' = IO () -> C_DragDndFinishedCallback
wrap_DragDndFinishedCallback IO ()
cb
    C_DragDndFinishedCallback -> IO (FunPtr C_DragDndFinishedCallback)
mk_DragDndFinishedCallback C_DragDndFinishedCallback
cb' IO (FunPtr C_DragDndFinishedCallback)
-> (FunPtr C_DragDndFinishedCallback
    -> IO (GClosure C_DragDndFinishedCallback))
-> IO (GClosure C_DragDndFinishedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DragDndFinishedCallback
-> IO (GClosure C_DragDndFinishedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DragDndFinishedCallback` into a `C_DragDndFinishedCallback`.
wrap_DragDndFinishedCallback ::
    DragDndFinishedCallback ->
    C_DragDndFinishedCallback
wrap_DragDndFinishedCallback :: IO () -> C_DragDndFinishedCallback
wrap_DragDndFinishedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [dndFinished](#signal:dndFinished) 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' drag #dndFinished callback
-- @
-- 
-- 
onDragDndFinished :: (IsDrag a, MonadIO m) => a -> DragDndFinishedCallback -> m SignalHandlerId
onDragDndFinished :: forall a (m :: * -> *).
(IsDrag a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onDragDndFinished a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragDndFinishedCallback
cb' = IO () -> C_DragDndFinishedCallback
wrap_DragDndFinishedCallback IO ()
cb
    FunPtr C_DragDndFinishedCallback
cb'' <- C_DragDndFinishedCallback -> IO (FunPtr C_DragDndFinishedCallback)
mk_DragDndFinishedCallback C_DragDndFinishedCallback
cb'
    a
-> Text
-> FunPtr C_DragDndFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"dnd-finished" FunPtr C_DragDndFinishedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dndFinished](#signal:dndFinished) 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' drag #dndFinished callback
-- @
-- 
-- 
afterDragDndFinished :: (IsDrag a, MonadIO m) => a -> DragDndFinishedCallback -> m SignalHandlerId
afterDragDndFinished :: forall a (m :: * -> *).
(IsDrag a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
afterDragDndFinished a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragDndFinishedCallback
cb' = IO () -> C_DragDndFinishedCallback
wrap_DragDndFinishedCallback IO ()
cb
    FunPtr C_DragDndFinishedCallback
cb'' <- C_DragDndFinishedCallback -> IO (FunPtr C_DragDndFinishedCallback)
mk_DragDndFinishedCallback C_DragDndFinishedCallback
cb'
    a
-> Text
-> FunPtr C_DragDndFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"dnd-finished" FunPtr C_DragDndFinishedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragDndFinishedSignalInfo
instance SignalInfo DragDndFinishedSignalInfo where
    type HaskellCallbackType DragDndFinishedSignalInfo = DragDndFinishedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragDndFinishedCallback cb
        cb'' <- mk_DragDndFinishedCallback cb'
        connectSignalFunPtr obj "dnd-finished" cb'' connectMode detail

#endif

-- signal Drag::drop-performed
-- | The drag operation was performed on an accepting client.
type DragDropPerformedCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DragDropPerformed :: MonadIO m => DragDropPerformedCallback -> m (GClosure C_DragDropPerformedCallback)
genClosure_DragDropPerformed :: forall (m :: * -> *).
MonadIO m =>
IO () -> m (GClosure C_DragDndFinishedCallback)
genClosure_DragDropPerformed IO ()
cb = IO (GClosure C_DragDndFinishedCallback)
-> m (GClosure C_DragDndFinishedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DragDndFinishedCallback)
 -> m (GClosure C_DragDndFinishedCallback))
-> IO (GClosure C_DragDndFinishedCallback)
-> m (GClosure C_DragDndFinishedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragDndFinishedCallback
cb' = IO () -> C_DragDndFinishedCallback
wrap_DragDropPerformedCallback IO ()
cb
    C_DragDndFinishedCallback -> IO (FunPtr C_DragDndFinishedCallback)
mk_DragDropPerformedCallback C_DragDndFinishedCallback
cb' IO (FunPtr C_DragDndFinishedCallback)
-> (FunPtr C_DragDndFinishedCallback
    -> IO (GClosure C_DragDndFinishedCallback))
-> IO (GClosure C_DragDndFinishedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DragDndFinishedCallback
-> IO (GClosure C_DragDndFinishedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DragDropPerformedCallback` into a `C_DragDropPerformedCallback`.
wrap_DragDropPerformedCallback ::
    DragDropPerformedCallback ->
    C_DragDropPerformedCallback
wrap_DragDropPerformedCallback :: IO () -> C_DragDndFinishedCallback
wrap_DragDropPerformedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [dropPerformed](#signal:dropPerformed) 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' drag #dropPerformed callback
-- @
-- 
-- 
onDragDropPerformed :: (IsDrag a, MonadIO m) => a -> DragDropPerformedCallback -> m SignalHandlerId
onDragDropPerformed :: forall a (m :: * -> *).
(IsDrag a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onDragDropPerformed a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragDndFinishedCallback
cb' = IO () -> C_DragDndFinishedCallback
wrap_DragDropPerformedCallback IO ()
cb
    FunPtr C_DragDndFinishedCallback
cb'' <- C_DragDndFinishedCallback -> IO (FunPtr C_DragDndFinishedCallback)
mk_DragDropPerformedCallback C_DragDndFinishedCallback
cb'
    a
-> Text
-> FunPtr C_DragDndFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drop-performed" FunPtr C_DragDndFinishedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [dropPerformed](#signal:dropPerformed) 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' drag #dropPerformed callback
-- @
-- 
-- 
afterDragDropPerformed :: (IsDrag a, MonadIO m) => a -> DragDropPerformedCallback -> m SignalHandlerId
afterDragDropPerformed :: forall a (m :: * -> *).
(IsDrag a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
afterDragDropPerformed a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DragDndFinishedCallback
cb' = IO () -> C_DragDndFinishedCallback
wrap_DragDropPerformedCallback IO ()
cb
    FunPtr C_DragDndFinishedCallback
cb'' <- C_DragDndFinishedCallback -> IO (FunPtr C_DragDndFinishedCallback)
mk_DragDropPerformedCallback C_DragDndFinishedCallback
cb'
    a
-> Text
-> FunPtr C_DragDndFinishedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drop-performed" FunPtr C_DragDndFinishedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DragDropPerformedSignalInfo
instance SignalInfo DragDropPerformedSignalInfo where
    type HaskellCallbackType DragDropPerformedSignalInfo = DragDropPerformedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DragDropPerformedCallback cb
        cb'' <- mk_DragDropPerformedCallback cb'
        connectSignalFunPtr obj "drop-performed" cb'' connectMode detail

#endif

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

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

-- | Set the value of the “@actions@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drag [ #actions 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragActions :: (MonadIO m, IsDrag o) => o -> [Gdk.Flags.DragAction] -> m ()
setDragActions :: forall (m :: * -> *) o.
(MonadIO m, IsDrag o) =>
o -> [DragAction] -> m ()
setDragActions o
obj [DragAction]
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 -> [DragAction] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"actions" [DragAction]
val

-- | Construct a `GValueConstruct` with valid value for the “@actions@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragActions :: (IsDrag o, MIO.MonadIO m) => [Gdk.Flags.DragAction] -> m (GValueConstruct o)
constructDragActions :: forall o (m :: * -> *).
(IsDrag o, MonadIO m) =>
[DragAction] -> m (GValueConstruct o)
constructDragActions [DragAction]
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 -> [DragAction] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"actions" [DragAction]
val

#if defined(ENABLE_OVERLOADING)
data DragActionsPropertyInfo
instance AttrInfo DragActionsPropertyInfo where
    type AttrAllowedOps DragActionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DragActionsPropertyInfo = IsDrag
    type AttrSetTypeConstraint DragActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferTypeConstraint DragActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferType DragActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrGetType DragActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrLabel DragActionsPropertyInfo = "actions"
    type AttrOrigin DragActionsPropertyInfo = Drag
    attrGet = getDragActions
    attrSet = setDragActions
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragActions
    attrClear = undefined
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DragContentPropertyInfo
instance AttrInfo DragContentPropertyInfo where
    type AttrAllowedOps DragContentPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragContentPropertyInfo = IsDrag
    type AttrSetTypeConstraint DragContentPropertyInfo = Gdk.ContentProvider.IsContentProvider
    type AttrTransferTypeConstraint DragContentPropertyInfo = Gdk.ContentProvider.IsContentProvider
    type AttrTransferType DragContentPropertyInfo = Gdk.ContentProvider.ContentProvider
    type AttrGetType DragContentPropertyInfo = Gdk.ContentProvider.ContentProvider
    type AttrLabel DragContentPropertyInfo = "content"
    type AttrOrigin DragContentPropertyInfo = Drag
    attrGet = getDragContent
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.ContentProvider.ContentProvider v
    attrConstruct = constructDragContent
    attrClear = undefined
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DragDevicePropertyInfo
instance AttrInfo DragDevicePropertyInfo where
    type AttrAllowedOps DragDevicePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragDevicePropertyInfo = IsDrag
    type AttrSetTypeConstraint DragDevicePropertyInfo = Gdk.Device.IsDevice
    type AttrTransferTypeConstraint DragDevicePropertyInfo = Gdk.Device.IsDevice
    type AttrTransferType DragDevicePropertyInfo = Gdk.Device.Device
    type AttrGetType DragDevicePropertyInfo = Gdk.Device.Device
    type AttrLabel DragDevicePropertyInfo = "device"
    type AttrOrigin DragDevicePropertyInfo = Drag
    attrGet = getDragDevice
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Device.Device v
    attrConstruct = constructDragDevice
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data DragDisplayPropertyInfo
instance AttrInfo DragDisplayPropertyInfo where
    type AttrAllowedOps DragDisplayPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragDisplayPropertyInfo = IsDrag
    type AttrSetTypeConstraint DragDisplayPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DragDisplayPropertyInfo = (~) ()
    type AttrTransferType DragDisplayPropertyInfo = ()
    type AttrGetType DragDisplayPropertyInfo = Gdk.Display.Display
    type AttrLabel DragDisplayPropertyInfo = "display"
    type AttrOrigin DragDisplayPropertyInfo = Drag
    attrGet = getDragDisplay
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DragFormatsPropertyInfo
instance AttrInfo DragFormatsPropertyInfo where
    type AttrAllowedOps DragFormatsPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragFormatsPropertyInfo = IsDrag
    type AttrSetTypeConstraint DragFormatsPropertyInfo = (~) Gdk.ContentFormats.ContentFormats
    type AttrTransferTypeConstraint DragFormatsPropertyInfo = (~) Gdk.ContentFormats.ContentFormats
    type AttrTransferType DragFormatsPropertyInfo = Gdk.ContentFormats.ContentFormats
    type AttrGetType DragFormatsPropertyInfo = Gdk.ContentFormats.ContentFormats
    type AttrLabel DragFormatsPropertyInfo = "formats"
    type AttrOrigin DragFormatsPropertyInfo = Drag
    attrGet = getDragFormats
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragFormats
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@selected-action@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' drag [ #selectedAction 'Data.GI.Base.Attributes.:=' value ]
-- @
setDragSelectedAction :: (MonadIO m, IsDrag o) => o -> [Gdk.Flags.DragAction] -> m ()
setDragSelectedAction :: forall (m :: * -> *) o.
(MonadIO m, IsDrag o) =>
o -> [DragAction] -> m ()
setDragSelectedAction o
obj [DragAction]
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 -> [DragAction] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"selected-action" [DragAction]
val

-- | Construct a `GValueConstruct` with valid value for the “@selected-action@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructDragSelectedAction :: (IsDrag o, MIO.MonadIO m) => [Gdk.Flags.DragAction] -> m (GValueConstruct o)
constructDragSelectedAction :: forall o (m :: * -> *).
(IsDrag o, MonadIO m) =>
[DragAction] -> m (GValueConstruct o)
constructDragSelectedAction [DragAction]
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 -> [DragAction] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"selected-action" [DragAction]
val

#if defined(ENABLE_OVERLOADING)
data DragSelectedActionPropertyInfo
instance AttrInfo DragSelectedActionPropertyInfo where
    type AttrAllowedOps DragSelectedActionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DragSelectedActionPropertyInfo = IsDrag
    type AttrSetTypeConstraint DragSelectedActionPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferTypeConstraint DragSelectedActionPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferType DragSelectedActionPropertyInfo = [Gdk.Flags.DragAction]
    type AttrGetType DragSelectedActionPropertyInfo = [Gdk.Flags.DragAction]
    type AttrLabel DragSelectedActionPropertyInfo = "selected-action"
    type AttrOrigin DragSelectedActionPropertyInfo = Drag
    attrGet = getDragSelectedAction
    attrSet = setDragSelectedAction
    attrTransfer _ v = do
        return v
    attrConstruct = constructDragSelectedAction
    attrClear = undefined
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DragSurfacePropertyInfo
instance AttrInfo DragSurfacePropertyInfo where
    type AttrAllowedOps DragSurfacePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DragSurfacePropertyInfo = IsDrag
    type AttrSetTypeConstraint DragSurfacePropertyInfo = Gdk.Surface.IsSurface
    type AttrTransferTypeConstraint DragSurfacePropertyInfo = Gdk.Surface.IsSurface
    type AttrTransferType DragSurfacePropertyInfo = Gdk.Surface.Surface
    type AttrGetType DragSurfacePropertyInfo = Gdk.Surface.Surface
    type AttrLabel DragSurfacePropertyInfo = "surface"
    type AttrOrigin DragSurfacePropertyInfo = Drag
    attrGet = getDragSurface
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Surface.Surface v
    attrConstruct = constructDragSurface
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Drag
type instance O.AttributeList Drag = DragAttributeList
type DragAttributeList = ('[ '("actions", DragActionsPropertyInfo), '("content", DragContentPropertyInfo), '("device", DragDevicePropertyInfo), '("display", DragDisplayPropertyInfo), '("formats", DragFormatsPropertyInfo), '("selectedAction", DragSelectedActionPropertyInfo), '("surface", DragSurfacePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
dragActions :: AttrLabelProxy "actions"
dragActions = AttrLabelProxy

dragContent :: AttrLabelProxy "content"
dragContent = AttrLabelProxy

dragDevice :: AttrLabelProxy "device"
dragDevice = AttrLabelProxy

dragDisplay :: AttrLabelProxy "display"
dragDisplay = AttrLabelProxy

dragFormats :: AttrLabelProxy "formats"
dragFormats = AttrLabelProxy

dragSelectedAction :: AttrLabelProxy "selectedAction"
dragSelectedAction = AttrLabelProxy

dragSurface :: AttrLabelProxy "surface"
dragSurface = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Drag = DragSignalList
type DragSignalList = ('[ '("cancel", DragCancelSignalInfo), '("dndFinished", DragDndFinishedSignalInfo), '("dropPerformed", DragDropPerformedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Drag::drop_done
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drag"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrag" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "success"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether the drag was ultimatively successful"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_drag_drop_done" gdk_drag_drop_done :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    CInt ->                                 -- success : TBasicType TBoolean
    IO ()

-- | Inform GDK if the drop ended successfully. Passing 'P.False'
-- for /@success@/ may trigger a drag cancellation animation.
-- 
-- This function is called by the drag source, and should
-- be the last call before dropping the reference to the
-- /@drag@/.
-- 
-- The t'GI.Gdk.Objects.Drag.Drag' will only take the first 'GI.Gdk.Objects.Drag.dragDropDone'
-- call as effective, if this function is called multiple times,
-- all subsequent calls will be ignored.
dragDropDone ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> Bool
    -- ^ /@success@/: whether the drag was ultimatively successful
    -> m ()
dragDropDone :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> Bool -> m ()
dragDropDone a
drag Bool
success = 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 Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    let success' :: CInt
success' = (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
success
    Ptr Drag -> CInt -> IO ()
gdk_drag_drop_done Ptr Drag
drag' CInt
success'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragDropDoneMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsDrag a) => O.OverloadedMethod DragDropDoneMethodInfo a signature where
    overloadedMethod = dragDropDone

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


#endif

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

foreign import ccall "gdk_drag_get_actions" gdk_drag_get_actions :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO CUInt

-- | Determines the bitmask of possible actions proposed by the source.
dragGetActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m [Gdk.Flags.DragAction]
    -- ^ __Returns:__ the t'GI.Gdk.Flags.DragAction' flags
dragGetActions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m [DragAction]
dragGetActions a
drag = 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 Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    CUInt
result <- Ptr Drag -> IO CUInt
gdk_drag_get_actions Ptr Drag
drag'
    let result' :: [DragAction]
result' = CUInt -> [DragAction]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    [DragAction] -> IO [DragAction]
forall (m :: * -> *) a. Monad m => a -> m a
return [DragAction]
result'

#if defined(ENABLE_OVERLOADING)
data DragGetActionsMethodInfo
instance (signature ~ (m [Gdk.Flags.DragAction]), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetActionsMethodInfo a signature where
    overloadedMethod = dragGetActions

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


#endif

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

foreign import ccall "gdk_drag_get_content" gdk_drag_get_content :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gdk.ContentProvider.ContentProvider)

-- | Returns the t'GI.Gdk.Objects.ContentProvider.ContentProvider' associated to the GdkDrag object.
dragGetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m Gdk.ContentProvider.ContentProvider
    -- ^ __Returns:__ The t'GI.Gdk.Objects.ContentProvider.ContentProvider' associated to /@drag@/.
dragGetContent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m ContentProvider
dragGetContent a
drag = IO ContentProvider -> m ContentProvider
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentProvider -> m ContentProvider)
-> IO ContentProvider -> m ContentProvider
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr ContentProvider
result <- Ptr Drag -> IO (Ptr ContentProvider)
gdk_drag_get_content Ptr Drag
drag'
    Text -> Ptr ContentProvider -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragGetContent" Ptr ContentProvider
result
    ContentProvider
result' <- ((ManagedPtr ContentProvider -> ContentProvider)
-> Ptr ContentProvider -> IO ContentProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContentProvider -> ContentProvider
Gdk.ContentProvider.ContentProvider) Ptr ContentProvider
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    ContentProvider -> IO ContentProvider
forall (m :: * -> *) a. Monad m => a -> m a
return ContentProvider
result'

#if defined(ENABLE_OVERLOADING)
data DragGetContentMethodInfo
instance (signature ~ (m Gdk.ContentProvider.ContentProvider), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetContentMethodInfo a signature where
    overloadedMethod = dragGetContent

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


#endif

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

foreign import ccall "gdk_drag_get_device" gdk_drag_get_device :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gdk.Device.Device)

-- | Returns the t'GI.Gdk.Objects.Device.Device' associated to the GdkDrag object.
dragGetDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m Gdk.Device.Device
    -- ^ __Returns:__ The t'GI.Gdk.Objects.Device.Device' associated to /@drag@/.
dragGetDevice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m Device
dragGetDevice a
drag = IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Device
result <- Ptr Drag -> IO (Ptr Device)
gdk_drag_get_device Ptr Drag
drag'
    Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragGetDevice" Ptr Device
result
    Device
result' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result'

#if defined(ENABLE_OVERLOADING)
data DragGetDeviceMethodInfo
instance (signature ~ (m Gdk.Device.Device), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetDeviceMethodInfo a signature where
    overloadedMethod = dragGetDevice

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


#endif

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

foreign import ccall "gdk_drag_get_display" gdk_drag_get_display :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the t'GI.Gdk.Objects.Display.Display' that the drag object was created for.
dragGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m Gdk.Display.Display
    -- ^ __Returns:__ a t'GI.Gdk.Objects.Display.Display'
dragGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m Display
dragGetDisplay a
drag = IO Display -> m Display
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Display -> m Display) -> IO Display -> m Display
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Display
result <- Ptr Drag -> IO (Ptr Display)
gdk_drag_get_display Ptr Drag
drag'
    Text -> Ptr Display -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragGetDisplay" Ptr Display
result
    Display
result' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    Display -> IO Display
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result'

#if defined(ENABLE_OVERLOADING)
data DragGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetDisplayMethodInfo a signature where
    overloadedMethod = dragGetDisplay

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


#endif

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

foreign import ccall "gdk_drag_get_drag_surface" gdk_drag_get_drag_surface :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gdk.Surface.Surface)

-- | Returns the surface on which the drag icon should be rendered
-- during the drag operation. Note that the surface may not be
-- available until the drag operation has begun. GDK will move
-- the surface in accordance with the ongoing drag operation.
-- The surface is owned by /@drag@/ and will be destroyed when
-- the drag operation is over.
dragGetDragSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m (Maybe Gdk.Surface.Surface)
    -- ^ __Returns:__ the drag surface, or 'P.Nothing'
dragGetDragSurface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m (Maybe Surface)
dragGetDragSurface a
drag = IO (Maybe Surface) -> m (Maybe Surface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Surface) -> m (Maybe Surface))
-> IO (Maybe Surface) -> m (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Surface
result <- Ptr Drag -> IO (Ptr Surface)
gdk_drag_get_drag_surface Ptr Drag
drag'
    Maybe Surface
maybeResult <- Ptr Surface -> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Surface
result ((Ptr Surface -> IO Surface) -> IO (Maybe Surface))
-> (Ptr Surface -> IO Surface) -> IO (Maybe Surface)
forall a b. (a -> b) -> a -> b
$ \Ptr Surface
result' -> do
        Surface
result'' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
result'
        Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    Maybe Surface -> IO (Maybe Surface)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Surface
maybeResult

#if defined(ENABLE_OVERLOADING)
data DragGetDragSurfaceMethodInfo
instance (signature ~ (m (Maybe Gdk.Surface.Surface)), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetDragSurfaceMethodInfo a signature where
    overloadedMethod = dragGetDragSurface

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


#endif

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

foreign import ccall "gdk_drag_get_formats" gdk_drag_get_formats :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gdk.ContentFormats.ContentFormats)

-- | Retrieves the formats supported by this GdkDrag object.
dragGetFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m Gdk.ContentFormats.ContentFormats
    -- ^ __Returns:__ a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
dragGetFormats :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m ContentFormats
dragGetFormats a
drag = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr ContentFormats
result <- Ptr Drag -> IO (Ptr ContentFormats)
gdk_drag_get_formats Ptr Drag
drag'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragGetFormats" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats) Ptr ContentFormats
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data DragGetFormatsMethodInfo
instance (signature ~ (m Gdk.ContentFormats.ContentFormats), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetFormatsMethodInfo a signature where
    overloadedMethod = dragGetFormats

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


#endif

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

foreign import ccall "gdk_drag_get_selected_action" gdk_drag_get_selected_action :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO CUInt

-- | Determines the action chosen by the drag destination.
dragGetSelectedAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m [Gdk.Flags.DragAction]
    -- ^ __Returns:__ a t'GI.Gdk.Flags.DragAction' value
dragGetSelectedAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m [DragAction]
dragGetSelectedAction a
drag = 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 Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    CUInt
result <- Ptr Drag -> IO CUInt
gdk_drag_get_selected_action Ptr Drag
drag'
    let result' :: [DragAction]
result' = CUInt -> [DragAction]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    [DragAction] -> IO [DragAction]
forall (m :: * -> *) a. Monad m => a -> m a
return [DragAction]
result'

#if defined(ENABLE_OVERLOADING)
data DragGetSelectedActionMethodInfo
instance (signature ~ (m [Gdk.Flags.DragAction]), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetSelectedActionMethodInfo a signature where
    overloadedMethod = dragGetSelectedAction

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


#endif

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

foreign import ccall "gdk_drag_get_surface" gdk_drag_get_surface :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    IO (Ptr Gdk.Surface.Surface)

-- | Returns the t'GI.Gdk.Objects.Surface.Surface' where the drag originates.
dragGetSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> m Gdk.Surface.Surface
    -- ^ __Returns:__ The t'GI.Gdk.Objects.Surface.Surface' where the drag originates
dragGetSurface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> m Surface
dragGetSurface a
drag = IO Surface -> m Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Surface
result <- Ptr Drag -> IO (Ptr Surface)
gdk_drag_get_surface Ptr Drag
drag'
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dragGetSurface" Ptr Surface
result
    Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data DragGetSurfaceMethodInfo
instance (signature ~ (m Gdk.Surface.Surface), MonadIO m, IsDrag a) => O.OverloadedMethod DragGetSurfaceMethodInfo a signature where
    overloadedMethod = dragGetSurface

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


#endif

-- method Drag::set_hotspot
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "drag"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrag" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hot_x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "x coordinate of the drag surface hotspot"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hot_y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "y coordinate of the drag surface hotspot"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_drag_set_hotspot" gdk_drag_set_hotspot :: 
    Ptr Drag ->                             -- drag : TInterface (Name {namespace = "Gdk", name = "Drag"})
    Int32 ->                                -- hot_x : TBasicType TInt
    Int32 ->                                -- hot_y : TBasicType TInt
    IO ()

-- | Sets the position of the drag surface that will be kept
-- under the cursor hotspot. Initially, the hotspot is at the
-- top left corner of the drag surface.
dragSetHotspot ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrag a) =>
    a
    -- ^ /@drag@/: a t'GI.Gdk.Objects.Drag.Drag'
    -> Int32
    -- ^ /@hotX@/: x coordinate of the drag surface hotspot
    -> Int32
    -- ^ /@hotY@/: y coordinate of the drag surface hotspot
    -> m ()
dragSetHotspot :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrag a) =>
a -> Int32 -> Int32 -> m ()
dragSetHotspot a
drag Int32
hotX Int32
hotY = 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 Drag
drag' <- a -> IO (Ptr Drag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
drag
    Ptr Drag -> Int32 -> Int32 -> IO ()
gdk_drag_set_hotspot Ptr Drag
drag' Int32
hotX Int32
hotY
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
drag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DragSetHotspotMethodInfo
instance (signature ~ (Int32 -> Int32 -> m ()), MonadIO m, IsDrag a) => O.OverloadedMethod DragSetHotspotMethodInfo a signature where
    overloadedMethod = dragSetHotspot

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


#endif

-- method Drag::begin
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "surface"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Surface" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source surface for this drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "device"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Device" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the device that controls this drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the offered content"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "actions"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the actions supported by this drag"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dx"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the x offset to @device's position where the drag nominally started"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dy"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the y offset to @device's position where the drag nominally started"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Drag" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_drag_begin" gdk_drag_begin :: 
    Ptr Gdk.Surface.Surface ->              -- surface : TInterface (Name {namespace = "Gdk", name = "Surface"})
    Ptr Gdk.Device.Device ->                -- device : TInterface (Name {namespace = "Gdk", name = "Device"})
    Ptr Gdk.ContentProvider.ContentProvider -> -- content : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    CUInt ->                                -- actions : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    CDouble ->                              -- dx : TBasicType TDouble
    CDouble ->                              -- dy : TBasicType TDouble
    IO (Ptr Drag)

-- | Starts a drag and creates a new drag context for it.
-- 
-- This function is called by the drag source. After this call, you
-- probably want to set up the drag icon using the surface returned
-- by 'GI.Gdk.Objects.Drag.dragGetDragSurface'.
-- 
-- This function returns a reference to the GdkDrag object, but GTK
-- keeps its own reference as well, as long as the DND operation is
-- going on.
-- 
-- Note: if /@actions@/ include 'GI.Gdk.Flags.DragActionMove', you need to listen for
-- the [dndFinished]("GI.Gdk.Objects.Drag#g:signal:dndFinished") signal and delete the data at the source
-- if 'GI.Gdk.Objects.Drag.dragGetSelectedAction' returns 'GI.Gdk.Flags.DragActionMove'.
dragBegin ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Surface.IsSurface a, Gdk.Device.IsDevice b, Gdk.ContentProvider.IsContentProvider c) =>
    a
    -- ^ /@surface@/: the source surface for this drag
    -> b
    -- ^ /@device@/: the device that controls this drag
    -> c
    -- ^ /@content@/: the offered content
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: the actions supported by this drag
    -> Double
    -- ^ /@dx@/: the x offset to /@device@/\'s position where the drag nominally started
    -> Double
    -- ^ /@dy@/: the y offset to /@device@/\'s position where the drag nominally started
    -> m (Maybe Drag)
    -- ^ __Returns:__ a newly created t'GI.Gdk.Objects.Drag.Drag' or
    --     'P.Nothing' on error.
dragBegin :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSurface a, IsDevice b,
 IsContentProvider c) =>
a -> b -> c -> [DragAction] -> Double -> Double -> m (Maybe Drag)
dragBegin a
surface b
device c
content [DragAction]
actions Double
dx Double
dy = IO (Maybe Drag) -> m (Maybe Drag)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Drag) -> m (Maybe Drag))
-> IO (Maybe Drag) -> m (Maybe Drag)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Surface
surface' <- a -> IO (Ptr Surface)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
surface
    Ptr Device
device' <- b -> IO (Ptr Device)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
device
    Ptr ContentProvider
content' <- c -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
content
    let actions' :: CUInt
actions' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
actions
    let dx' :: CDouble
dx' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dx
    let dy' :: CDouble
dy' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
dy
    Ptr Drag
result <- Ptr Surface
-> Ptr Device
-> Ptr ContentProvider
-> CUInt
-> CDouble
-> CDouble
-> IO (Ptr Drag)
gdk_drag_begin Ptr Surface
surface' Ptr Device
device' Ptr ContentProvider
content' CUInt
actions' CDouble
dx' CDouble
dy'
    Maybe Drag
maybeResult <- Ptr Drag -> (Ptr Drag -> IO Drag) -> IO (Maybe Drag)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Drag
result ((Ptr Drag -> IO Drag) -> IO (Maybe Drag))
-> (Ptr Drag -> IO Drag) -> IO (Maybe Drag)
forall a b. (a -> b) -> a -> b
$ \Ptr Drag
result' -> do
        Drag
result'' <- ((ManagedPtr Drag -> Drag) -> Ptr Drag -> IO Drag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Drag -> Drag
Drag) Ptr Drag
result'
        Drag -> IO Drag
forall (m :: * -> *) a. Monad m => a -> m a
return Drag
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
surface
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
device
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
content
    Maybe Drag -> IO (Maybe Drag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drag
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif