{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- GtkDropTarget is an event controller implementing a simple way to
-- receive Drag-and-Drop operations.
-- 
-- The most basic way to use a t'GI.Gtk.Objects.DropTarget.DropTarget' to receive drops on a
-- widget is to create it via 'GI.Gtk.Objects.DropTarget.dropTargetNew' passing in the
-- t'GType' of the data you want to receive and connect to the
-- GtkDropTarget[drop](#g:signal:drop) signal to receive the data.
-- 
-- t'GI.Gtk.Objects.DropTarget.DropTarget' supports more options, such as:
-- 
--  * rejecting potential drops via the [accept]("GI.Gtk.Objects.DropTarget#g:signal:accept") signal
--    and the 'GI.Gtk.Objects.DropTarget.dropTargetReject' function to let other drop
--    targets handle the drop
--  * tracking an ongoing drag operation before the drop via the
--    [enter]("GI.Gtk.Objects.DropTarget#g:signal:enter"), [motion]("GI.Gtk.Objects.DropTarget#g:signal:motion") and
--    [leave]("GI.Gtk.Objects.DropTarget#g:signal:leave") signals
--  * configuring how to receive data by setting the
--    t'GI.Gtk.Objects.DropTarget.DropTarget':@/preload/@ property and listening for its availability
--    via the t'GI.Gtk.Objects.DropTarget.DropTarget':@/value/@ property
-- 
-- However, t'GI.Gtk.Objects.DropTarget.DropTarget' is ultimately modeled in a synchronous way
-- and only supports data transferred via t'GType'.
-- If you want full control over an ongoing drop, the t'GI.Gtk.Objects.DropTargetAsync.DropTargetAsync'
-- object gives you this ability.
-- 
-- While a pointer is dragged over the drop target\'s widget and the drop
-- has not been rejected, that widget will receive the
-- 'GI.Gtk.Flags.StateFlagsDropActive' state, which can be used to style the widget.

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

module GI.Gtk.Objects.DropTarget
    ( 

-- * Exported types
    DropTarget(..)                          ,
    IsDropTarget                            ,
    toDropTarget                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveDropTargetMethod                 ,
#endif


-- ** getActions #method:getActions#

#if defined(ENABLE_OVERLOADING)
    DropTargetGetActionsMethodInfo          ,
#endif
    dropTargetGetActions                    ,


-- ** getDrop #method:getDrop#

#if defined(ENABLE_OVERLOADING)
    DropTargetGetDropMethodInfo             ,
#endif
    dropTargetGetDrop                       ,


-- ** getFormats #method:getFormats#

#if defined(ENABLE_OVERLOADING)
    DropTargetGetFormatsMethodInfo          ,
#endif
    dropTargetGetFormats                    ,


-- ** getGtypes #method:getGtypes#

#if defined(ENABLE_OVERLOADING)
    DropTargetGetGtypesMethodInfo           ,
#endif
    dropTargetGetGtypes                     ,


-- ** getPreload #method:getPreload#

#if defined(ENABLE_OVERLOADING)
    DropTargetGetPreloadMethodInfo          ,
#endif
    dropTargetGetPreload                    ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    DropTargetGetValueMethodInfo            ,
#endif
    dropTargetGetValue                      ,


-- ** new #method:new#

    dropTargetNew                           ,


-- ** reject #method:reject#

#if defined(ENABLE_OVERLOADING)
    DropTargetRejectMethodInfo              ,
#endif
    dropTargetReject                        ,


-- ** setActions #method:setActions#

#if defined(ENABLE_OVERLOADING)
    DropTargetSetActionsMethodInfo          ,
#endif
    dropTargetSetActions                    ,


-- ** setGtypes #method:setGtypes#

#if defined(ENABLE_OVERLOADING)
    DropTargetSetGtypesMethodInfo           ,
#endif
    dropTargetSetGtypes                     ,


-- ** setPreload #method:setPreload#

#if defined(ENABLE_OVERLOADING)
    DropTargetSetPreloadMethodInfo          ,
#endif
    dropTargetSetPreload                    ,




 -- * Properties
-- ** actions #attr:actions#
-- | The @/GdkDragActions/@ that this drop target supports

#if defined(ENABLE_OVERLOADING)
    DropTargetActionsPropertyInfo           ,
#endif
    constructDropTargetActions              ,
#if defined(ENABLE_OVERLOADING)
    dropTargetActions                       ,
#endif
    getDropTargetActions                    ,
    setDropTargetActions                    ,


-- ** drop #attr:drop#
-- | The t'GI.Gdk.Objects.Drop.Drop' that is currently being performed

#if defined(ENABLE_OVERLOADING)
    DropTargetDropPropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    dropTargetDrop                          ,
#endif
    getDropTargetDrop                       ,


-- ** formats #attr:formats#
-- | The t'GI.Gdk.Structs.ContentFormats.ContentFormats' that determine the supported data formats

#if defined(ENABLE_OVERLOADING)
    DropTargetFormatsPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    dropTargetFormats                       ,
#endif
    getDropTargetFormats                    ,


-- ** preload #attr:preload#
-- | Whether the drop data should be preloaded when the pointer is only
-- hovering over the widget but has not been released.
-- 
-- Setting this property allows finer grained reaction to an ongoing
-- drop at the cost of loading more data.
-- 
-- The default value for this property is 'P.False' to avoid downloading
-- huge amounts of data by accident.
-- For example, if somebody drags a full document of gigabytes of text
-- from a text editor across a widget with a preloading drop target,
-- this data will be downloaded, even if the data is ultimately dropped
-- elsewhere.
-- 
-- For a lot of data formats, the amount of data is very small (like
-- @/GDK_TYPE_RGBA/@), so enabling this property does not hurt at all.
-- And for local-only drag\'n\'drop operations, no data transfer is done,
-- so enabling it there is free.

#if defined(ENABLE_OVERLOADING)
    DropTargetPreloadPropertyInfo           ,
#endif
    constructDropTargetPreload              ,
#if defined(ENABLE_OVERLOADING)
    dropTargetPreload                       ,
#endif
    getDropTargetPreload                    ,
    setDropTargetPreload                    ,


-- ** value #attr:value#
-- | The value for this drop operation or 'P.Nothing' if the data has not been
-- loaded yet or no drop operation is going on.
-- 
-- Data may be available before the GtkDropTarget[drop](#g:signal:drop) signal gets emitted -
-- for example when the GtkDropTarget:preload property is set.
-- You can use the GObject[notify](#g:signal:notify) signal to be notified of available data.

#if defined(ENABLE_OVERLOADING)
    DropTargetValuePropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    dropTargetValue                         ,
#endif
    getDropTargetValue                      ,




 -- * Signals
-- ** accept #signal:accept#

    C_DropTargetAcceptCallback              ,
    DropTargetAcceptCallback                ,
#if defined(ENABLE_OVERLOADING)
    DropTargetAcceptSignalInfo              ,
#endif
    afterDropTargetAccept                   ,
    genClosure_DropTargetAccept             ,
    mk_DropTargetAcceptCallback             ,
    noDropTargetAcceptCallback              ,
    onDropTargetAccept                      ,
    wrap_DropTargetAcceptCallback           ,


-- ** drop #signal:drop#

    C_DropTargetDropCallback                ,
    DropTargetDropCallback                  ,
#if defined(ENABLE_OVERLOADING)
    DropTargetDropSignalInfo                ,
#endif
    afterDropTargetDrop                     ,
    genClosure_DropTargetDrop               ,
    mk_DropTargetDropCallback               ,
    noDropTargetDropCallback                ,
    onDropTargetDrop                        ,
    wrap_DropTargetDropCallback             ,


-- ** enter #signal:enter#

    C_DropTargetEnterCallback               ,
    DropTargetEnterCallback                 ,
#if defined(ENABLE_OVERLOADING)
    DropTargetEnterSignalInfo               ,
#endif
    afterDropTargetEnter                    ,
    genClosure_DropTargetEnter              ,
    mk_DropTargetEnterCallback              ,
    noDropTargetEnterCallback               ,
    onDropTargetEnter                       ,
    wrap_DropTargetEnterCallback            ,


-- ** leave #signal:leave#

    C_DropTargetLeaveCallback               ,
    DropTargetLeaveCallback                 ,
#if defined(ENABLE_OVERLOADING)
    DropTargetLeaveSignalInfo               ,
#endif
    afterDropTargetLeave                    ,
    genClosure_DropTargetLeave              ,
    mk_DropTargetLeaveCallback              ,
    noDropTargetLeaveCallback               ,
    onDropTargetLeave                       ,
    wrap_DropTargetLeaveCallback            ,


-- ** motion #signal:motion#

    C_DropTargetMotionCallback              ,
    DropTargetMotionCallback                ,
#if defined(ENABLE_OVERLOADING)
    DropTargetMotionSignalInfo              ,
#endif
    afterDropTargetMotion                   ,
    genClosure_DropTargetMotion             ,
    mk_DropTargetMotionCallback             ,
    noDropTargetMotionCallback              ,
    onDropTargetMotion                      ,
    wrap_DropTargetMotionCallback           ,




    ) 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.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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Objects.Drop as Gdk.Drop
import qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController

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

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

foreign import ccall "gtk_drop_target_get_type"
    c_gtk_drop_target_get_type :: IO B.Types.GType

instance B.Types.TypedObject DropTarget where
    glibType :: IO GType
glibType = IO GType
c_gtk_drop_target_get_type

instance B.Types.GObject DropTarget

-- | Convert 'DropTarget' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue DropTarget where
    toGValue :: DropTarget -> IO GValue
toGValue DropTarget
o = do
        GType
gtype <- IO GType
c_gtk_drop_target_get_type
        DropTarget -> (Ptr DropTarget -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DropTarget
o (GType
-> (GValue -> Ptr DropTarget -> IO ())
-> Ptr DropTarget
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr DropTarget -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO DropTarget
fromGValue GValue
gv = do
        Ptr DropTarget
ptr <- GValue -> IO (Ptr DropTarget)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr DropTarget)
        (ManagedPtr DropTarget -> DropTarget)
-> Ptr DropTarget -> IO DropTarget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr DropTarget -> DropTarget
DropTarget Ptr DropTarget
ptr
        
    

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

instance O.HasParentTypes DropTarget
type instance O.ParentTypes DropTarget = '[Gtk.EventController.EventController, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDropTargetMethod (t :: Symbol) (o :: *) :: * where
    ResolveDropTargetMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDropTargetMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDropTargetMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDropTargetMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDropTargetMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDropTargetMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDropTargetMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDropTargetMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDropTargetMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDropTargetMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDropTargetMethod "reject" o = DropTargetRejectMethodInfo
    ResolveDropTargetMethod "reset" o = Gtk.EventController.EventControllerResetMethodInfo
    ResolveDropTargetMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDropTargetMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDropTargetMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDropTargetMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDropTargetMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDropTargetMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDropTargetMethod "getActions" o = DropTargetGetActionsMethodInfo
    ResolveDropTargetMethod "getCurrentEvent" o = Gtk.EventController.EventControllerGetCurrentEventMethodInfo
    ResolveDropTargetMethod "getCurrentEventDevice" o = Gtk.EventController.EventControllerGetCurrentEventDeviceMethodInfo
    ResolveDropTargetMethod "getCurrentEventState" o = Gtk.EventController.EventControllerGetCurrentEventStateMethodInfo
    ResolveDropTargetMethod "getCurrentEventTime" o = Gtk.EventController.EventControllerGetCurrentEventTimeMethodInfo
    ResolveDropTargetMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDropTargetMethod "getDrop" o = DropTargetGetDropMethodInfo
    ResolveDropTargetMethod "getFormats" o = DropTargetGetFormatsMethodInfo
    ResolveDropTargetMethod "getGtypes" o = DropTargetGetGtypesMethodInfo
    ResolveDropTargetMethod "getName" o = Gtk.EventController.EventControllerGetNameMethodInfo
    ResolveDropTargetMethod "getPreload" o = DropTargetGetPreloadMethodInfo
    ResolveDropTargetMethod "getPropagationLimit" o = Gtk.EventController.EventControllerGetPropagationLimitMethodInfo
    ResolveDropTargetMethod "getPropagationPhase" o = Gtk.EventController.EventControllerGetPropagationPhaseMethodInfo
    ResolveDropTargetMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDropTargetMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDropTargetMethod "getValue" o = DropTargetGetValueMethodInfo
    ResolveDropTargetMethod "getWidget" o = Gtk.EventController.EventControllerGetWidgetMethodInfo
    ResolveDropTargetMethod "setActions" o = DropTargetSetActionsMethodInfo
    ResolveDropTargetMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDropTargetMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDropTargetMethod "setGtypes" o = DropTargetSetGtypesMethodInfo
    ResolveDropTargetMethod "setName" o = Gtk.EventController.EventControllerSetNameMethodInfo
    ResolveDropTargetMethod "setPreload" o = DropTargetSetPreloadMethodInfo
    ResolveDropTargetMethod "setPropagationLimit" o = Gtk.EventController.EventControllerSetPropagationLimitMethodInfo
    ResolveDropTargetMethod "setPropagationPhase" o = Gtk.EventController.EventControllerSetPropagationPhaseMethodInfo
    ResolveDropTargetMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDropTargetMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal DropTarget::accept
-- | The [accept](#g:signal:accept) signal is emitted on the drop site when a drop operation
-- is about to begin.
-- If the drop is not accepted, 'P.False' will be returned and the drop target
-- will ignore the drop. If 'P.True' is returned, the drop is accepted for now
-- but may be rejected later via a call to 'GI.Gtk.Objects.DropTarget.dropTargetReject' or
-- ultimately by returning 'P.False' from GtkDropTarget[drop](#g:signal:drop)
-- 
-- The default handler for this signal decides whether to accept the drop
-- based on the formats provided by the /@drop@/.
-- 
-- If the decision whether the drop will be accepted or rejected needs
-- inspecting the data, this function should return 'P.True', the
-- GtkDropTarget:preload property should be set and the value
-- should be inspected via the GObject[notify](#g:signal:notify):value signal and then call
-- 'GI.Gtk.Objects.DropTarget.dropTargetReject'.
type DropTargetAcceptCallback =
    Gdk.Drop.Drop
    -- ^ /@drop@/: the t'GI.Gdk.Objects.Drop.Drop'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@drop@/ is accepted

-- | A convenience synonym for @`Nothing` :: `Maybe` `DropTargetAcceptCallback`@.
noDropTargetAcceptCallback :: Maybe DropTargetAcceptCallback
noDropTargetAcceptCallback :: Maybe DropTargetAcceptCallback
noDropTargetAcceptCallback = Maybe DropTargetAcceptCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DropTargetAccept :: MonadIO m => DropTargetAcceptCallback -> m (GClosure C_DropTargetAcceptCallback)
genClosure_DropTargetAccept :: DropTargetAcceptCallback -> m (GClosure C_DropTargetAcceptCallback)
genClosure_DropTargetAccept DropTargetAcceptCallback
cb = IO (GClosure C_DropTargetAcceptCallback)
-> m (GClosure C_DropTargetAcceptCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DropTargetAcceptCallback)
 -> m (GClosure C_DropTargetAcceptCallback))
-> IO (GClosure C_DropTargetAcceptCallback)
-> m (GClosure C_DropTargetAcceptCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DropTargetAcceptCallback
cb' = DropTargetAcceptCallback -> C_DropTargetAcceptCallback
wrap_DropTargetAcceptCallback DropTargetAcceptCallback
cb
    C_DropTargetAcceptCallback
-> IO (FunPtr C_DropTargetAcceptCallback)
mk_DropTargetAcceptCallback C_DropTargetAcceptCallback
cb' IO (FunPtr C_DropTargetAcceptCallback)
-> (FunPtr C_DropTargetAcceptCallback
    -> IO (GClosure C_DropTargetAcceptCallback))
-> IO (GClosure C_DropTargetAcceptCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DropTargetAcceptCallback
-> IO (GClosure C_DropTargetAcceptCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DropTargetAcceptCallback` into a `C_DropTargetAcceptCallback`.
wrap_DropTargetAcceptCallback ::
    DropTargetAcceptCallback ->
    C_DropTargetAcceptCallback
wrap_DropTargetAcceptCallback :: DropTargetAcceptCallback -> C_DropTargetAcceptCallback
wrap_DropTargetAcceptCallback DropTargetAcceptCallback
_cb Ptr ()
_ Ptr Drop
drop Ptr ()
_ = do
    Drop
drop' <- ((ManagedPtr Drop -> Drop) -> Ptr Drop -> IO Drop
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drop -> Drop
Gdk.Drop.Drop) Ptr Drop
drop
    Bool
result <- DropTargetAcceptCallback
_cb  Drop
drop'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [accept](#signal:accept) 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' dropTarget #accept callback
-- @
-- 
-- 
onDropTargetAccept :: (IsDropTarget a, MonadIO m) => a -> DropTargetAcceptCallback -> m SignalHandlerId
onDropTargetAccept :: a -> DropTargetAcceptCallback -> m SignalHandlerId
onDropTargetAccept a
obj DropTargetAcceptCallback
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_DropTargetAcceptCallback
cb' = DropTargetAcceptCallback -> C_DropTargetAcceptCallback
wrap_DropTargetAcceptCallback DropTargetAcceptCallback
cb
    FunPtr C_DropTargetAcceptCallback
cb'' <- C_DropTargetAcceptCallback
-> IO (FunPtr C_DropTargetAcceptCallback)
mk_DropTargetAcceptCallback C_DropTargetAcceptCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetAcceptCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"accept" FunPtr C_DropTargetAcceptCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [accept](#signal:accept) 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' dropTarget #accept callback
-- @
-- 
-- 
afterDropTargetAccept :: (IsDropTarget a, MonadIO m) => a -> DropTargetAcceptCallback -> m SignalHandlerId
afterDropTargetAccept :: a -> DropTargetAcceptCallback -> m SignalHandlerId
afterDropTargetAccept a
obj DropTargetAcceptCallback
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_DropTargetAcceptCallback
cb' = DropTargetAcceptCallback -> C_DropTargetAcceptCallback
wrap_DropTargetAcceptCallback DropTargetAcceptCallback
cb
    FunPtr C_DropTargetAcceptCallback
cb'' <- C_DropTargetAcceptCallback
-> IO (FunPtr C_DropTargetAcceptCallback)
mk_DropTargetAcceptCallback C_DropTargetAcceptCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetAcceptCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"accept" FunPtr C_DropTargetAcceptCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DropTargetAcceptSignalInfo
instance SignalInfo DropTargetAcceptSignalInfo where
    type HaskellCallbackType DropTargetAcceptSignalInfo = DropTargetAcceptCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DropTargetAcceptCallback cb
        cb'' <- mk_DropTargetAcceptCallback cb'
        connectSignalFunPtr obj "accept" cb'' connectMode detail

#endif

-- signal DropTarget::drop
-- | The [drop](#g:signal:drop) signal is emitted on the drop site when the user drops
-- the data onto the widget. The signal handler must determine whether
-- the pointer position is in a drop zone or not. If it is not in a drop
-- zone, it returns 'P.False' and no further processing is necessary.
-- 
-- Otherwise, the handler returns 'P.True'. In this case, this handler will
-- accept the drop. The handler is responsible for rading the given /@value@/
-- and performing the drop operation.
type DropTargetDropCallback =
    GValue
    -- ^ /@value@/: the t'GI.GObject.Structs.Value.Value' being dropped
    -> Double
    -- ^ /@x@/: the x coordinate of the current pointer position
    -> Double
    -- ^ /@y@/: the y coordinate of the current pointer position
    -> IO Bool
    -- ^ __Returns:__ whether the drop was accepted at the given pointer position

-- | A convenience synonym for @`Nothing` :: `Maybe` `DropTargetDropCallback`@.
noDropTargetDropCallback :: Maybe DropTargetDropCallback
noDropTargetDropCallback :: Maybe DropTargetDropCallback
noDropTargetDropCallback = Maybe DropTargetDropCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DropTargetDrop :: MonadIO m => DropTargetDropCallback -> m (GClosure C_DropTargetDropCallback)
genClosure_DropTargetDrop :: DropTargetDropCallback -> m (GClosure C_DropTargetDropCallback)
genClosure_DropTargetDrop DropTargetDropCallback
cb = IO (GClosure C_DropTargetDropCallback)
-> m (GClosure C_DropTargetDropCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DropTargetDropCallback)
 -> m (GClosure C_DropTargetDropCallback))
-> IO (GClosure C_DropTargetDropCallback)
-> m (GClosure C_DropTargetDropCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DropTargetDropCallback
cb' = DropTargetDropCallback -> C_DropTargetDropCallback
wrap_DropTargetDropCallback DropTargetDropCallback
cb
    C_DropTargetDropCallback -> IO (FunPtr C_DropTargetDropCallback)
mk_DropTargetDropCallback C_DropTargetDropCallback
cb' IO (FunPtr C_DropTargetDropCallback)
-> (FunPtr C_DropTargetDropCallback
    -> IO (GClosure C_DropTargetDropCallback))
-> IO (GClosure C_DropTargetDropCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DropTargetDropCallback
-> IO (GClosure C_DropTargetDropCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DropTargetDropCallback` into a `C_DropTargetDropCallback`.
wrap_DropTargetDropCallback ::
    DropTargetDropCallback ->
    C_DropTargetDropCallback
wrap_DropTargetDropCallback :: DropTargetDropCallback -> C_DropTargetDropCallback
wrap_DropTargetDropCallback DropTargetDropCallback
_cb Ptr ()
_ Ptr GValue
value CDouble
x CDouble
y Ptr ()
_ = do
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
value
    let x' :: Double
x' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x
    let y' :: Double
y' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y
    Bool
result <- DropTargetDropCallback
_cb  GValue
value' Double
x' Double
y'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [drop](#signal:drop) 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' dropTarget #drop callback
-- @
-- 
-- 
onDropTargetDrop :: (IsDropTarget a, MonadIO m) => a -> DropTargetDropCallback -> m SignalHandlerId
onDropTargetDrop :: a -> DropTargetDropCallback -> m SignalHandlerId
onDropTargetDrop a
obj DropTargetDropCallback
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_DropTargetDropCallback
cb' = DropTargetDropCallback -> C_DropTargetDropCallback
wrap_DropTargetDropCallback DropTargetDropCallback
cb
    FunPtr C_DropTargetDropCallback
cb'' <- C_DropTargetDropCallback -> IO (FunPtr C_DropTargetDropCallback)
mk_DropTargetDropCallback C_DropTargetDropCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetDropCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drop" FunPtr C_DropTargetDropCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [drop](#signal:drop) 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' dropTarget #drop callback
-- @
-- 
-- 
afterDropTargetDrop :: (IsDropTarget a, MonadIO m) => a -> DropTargetDropCallback -> m SignalHandlerId
afterDropTargetDrop :: a -> DropTargetDropCallback -> m SignalHandlerId
afterDropTargetDrop a
obj DropTargetDropCallback
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_DropTargetDropCallback
cb' = DropTargetDropCallback -> C_DropTargetDropCallback
wrap_DropTargetDropCallback DropTargetDropCallback
cb
    FunPtr C_DropTargetDropCallback
cb'' <- C_DropTargetDropCallback -> IO (FunPtr C_DropTargetDropCallback)
mk_DropTargetDropCallback C_DropTargetDropCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetDropCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drop" FunPtr C_DropTargetDropCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DropTargetDropSignalInfo
instance SignalInfo DropTargetDropSignalInfo where
    type HaskellCallbackType DropTargetDropSignalInfo = DropTargetDropCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DropTargetDropCallback cb
        cb'' <- mk_DropTargetDropCallback cb'
        connectSignalFunPtr obj "drop" cb'' connectMode detail

#endif

-- signal DropTarget::enter
-- | The [enter](#g:signal:enter) signal is emitted on the drop site when the pointer
-- enters the widget. It can be used to set up custom highlighting.
type DropTargetEnterCallback =
    Double
    -- ^ /@x@/: the x coordinate of the current pointer position
    -> Double
    -- ^ /@y@/: the y coordinate of the current pointer position
    -> IO [Gdk.Flags.DragAction]
    -- ^ __Returns:__ Preferred action for this drag operation or 0 if dropping is not
    --     supported at the current /@x@/,/@y@/ location.

-- | A convenience synonym for @`Nothing` :: `Maybe` `DropTargetEnterCallback`@.
noDropTargetEnterCallback :: Maybe DropTargetEnterCallback
noDropTargetEnterCallback :: Maybe DropTargetEnterCallback
noDropTargetEnterCallback = Maybe DropTargetEnterCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DropTargetEnter :: MonadIO m => DropTargetEnterCallback -> m (GClosure C_DropTargetEnterCallback)
genClosure_DropTargetEnter :: DropTargetEnterCallback -> m (GClosure C_DropTargetEnterCallback)
genClosure_DropTargetEnter DropTargetEnterCallback
cb = IO (GClosure C_DropTargetEnterCallback)
-> m (GClosure C_DropTargetEnterCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DropTargetEnterCallback)
 -> m (GClosure C_DropTargetEnterCallback))
-> IO (GClosure C_DropTargetEnterCallback)
-> m (GClosure C_DropTargetEnterCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DropTargetEnterCallback
cb' = DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetEnterCallback DropTargetEnterCallback
cb
    C_DropTargetEnterCallback -> IO (FunPtr C_DropTargetEnterCallback)
mk_DropTargetEnterCallback C_DropTargetEnterCallback
cb' IO (FunPtr C_DropTargetEnterCallback)
-> (FunPtr C_DropTargetEnterCallback
    -> IO (GClosure C_DropTargetEnterCallback))
-> IO (GClosure C_DropTargetEnterCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DropTargetEnterCallback
-> IO (GClosure C_DropTargetEnterCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DropTargetEnterCallback` into a `C_DropTargetEnterCallback`.
wrap_DropTargetEnterCallback ::
    DropTargetEnterCallback ->
    C_DropTargetEnterCallback
wrap_DropTargetEnterCallback :: DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetEnterCallback DropTargetEnterCallback
_cb Ptr ()
_ CDouble
x CDouble
y Ptr ()
_ = do
    let x' :: Double
x' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x
    let y' :: Double
y' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y
    [DragAction]
result <- DropTargetEnterCallback
_cb  Double
x' Double
y'
    let result' :: CUInt
result' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
result
    CUInt -> IO CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
result'


-- | Connect a signal handler for the [enter](#signal:enter) 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' dropTarget #enter callback
-- @
-- 
-- 
onDropTargetEnter :: (IsDropTarget a, MonadIO m) => a -> DropTargetEnterCallback -> m SignalHandlerId
onDropTargetEnter :: a -> DropTargetEnterCallback -> m SignalHandlerId
onDropTargetEnter a
obj DropTargetEnterCallback
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_DropTargetEnterCallback
cb' = DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetEnterCallback DropTargetEnterCallback
cb
    FunPtr C_DropTargetEnterCallback
cb'' <- C_DropTargetEnterCallback -> IO (FunPtr C_DropTargetEnterCallback)
mk_DropTargetEnterCallback C_DropTargetEnterCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetEnterCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"enter" FunPtr C_DropTargetEnterCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [enter](#signal:enter) 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' dropTarget #enter callback
-- @
-- 
-- 
afterDropTargetEnter :: (IsDropTarget a, MonadIO m) => a -> DropTargetEnterCallback -> m SignalHandlerId
afterDropTargetEnter :: a -> DropTargetEnterCallback -> m SignalHandlerId
afterDropTargetEnter a
obj DropTargetEnterCallback
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_DropTargetEnterCallback
cb' = DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetEnterCallback DropTargetEnterCallback
cb
    FunPtr C_DropTargetEnterCallback
cb'' <- C_DropTargetEnterCallback -> IO (FunPtr C_DropTargetEnterCallback)
mk_DropTargetEnterCallback C_DropTargetEnterCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetEnterCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"enter" FunPtr C_DropTargetEnterCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DropTargetEnterSignalInfo
instance SignalInfo DropTargetEnterSignalInfo where
    type HaskellCallbackType DropTargetEnterSignalInfo = DropTargetEnterCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DropTargetEnterCallback cb
        cb'' <- mk_DropTargetEnterCallback cb'
        connectSignalFunPtr obj "enter" cb'' connectMode detail

#endif

-- signal DropTarget::leave
-- | The [leave](#g:signal:leave) signal is emitted on the drop site when the pointer
-- leaves the widget. Its main purpose it to undo things done in
-- [enter]("GI.Gtk.Objects.DropTarget#g:signal:enter").
type DropTargetLeaveCallback =
    IO ()

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

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DropTargetLeave :: MonadIO m => DropTargetLeaveCallback -> m (GClosure C_DropTargetLeaveCallback)
genClosure_DropTargetLeave :: IO () -> m (GClosure C_DropTargetLeaveCallback)
genClosure_DropTargetLeave IO ()
cb = IO (GClosure C_DropTargetLeaveCallback)
-> m (GClosure C_DropTargetLeaveCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DropTargetLeaveCallback)
 -> m (GClosure C_DropTargetLeaveCallback))
-> IO (GClosure C_DropTargetLeaveCallback)
-> m (GClosure C_DropTargetLeaveCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DropTargetLeaveCallback
cb' = IO () -> C_DropTargetLeaveCallback
wrap_DropTargetLeaveCallback IO ()
cb
    C_DropTargetLeaveCallback -> IO (FunPtr C_DropTargetLeaveCallback)
mk_DropTargetLeaveCallback C_DropTargetLeaveCallback
cb' IO (FunPtr C_DropTargetLeaveCallback)
-> (FunPtr C_DropTargetLeaveCallback
    -> IO (GClosure C_DropTargetLeaveCallback))
-> IO (GClosure C_DropTargetLeaveCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DropTargetLeaveCallback
-> IO (GClosure C_DropTargetLeaveCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DropTargetLeaveCallback` into a `C_DropTargetLeaveCallback`.
wrap_DropTargetLeaveCallback ::
    DropTargetLeaveCallback ->
    C_DropTargetLeaveCallback
wrap_DropTargetLeaveCallback :: IO () -> C_DropTargetLeaveCallback
wrap_DropTargetLeaveCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [leave](#signal:leave) 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' dropTarget #leave callback
-- @
-- 
-- 
onDropTargetLeave :: (IsDropTarget a, MonadIO m) => a -> DropTargetLeaveCallback -> m SignalHandlerId
onDropTargetLeave :: a -> IO () -> m SignalHandlerId
onDropTargetLeave 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_DropTargetLeaveCallback
cb' = IO () -> C_DropTargetLeaveCallback
wrap_DropTargetLeaveCallback IO ()
cb
    FunPtr C_DropTargetLeaveCallback
cb'' <- C_DropTargetLeaveCallback -> IO (FunPtr C_DropTargetLeaveCallback)
mk_DropTargetLeaveCallback C_DropTargetLeaveCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetLeaveCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"leave" FunPtr C_DropTargetLeaveCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [leave](#signal:leave) 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' dropTarget #leave callback
-- @
-- 
-- 
afterDropTargetLeave :: (IsDropTarget a, MonadIO m) => a -> DropTargetLeaveCallback -> m SignalHandlerId
afterDropTargetLeave :: a -> IO () -> m SignalHandlerId
afterDropTargetLeave 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_DropTargetLeaveCallback
cb' = IO () -> C_DropTargetLeaveCallback
wrap_DropTargetLeaveCallback IO ()
cb
    FunPtr C_DropTargetLeaveCallback
cb'' <- C_DropTargetLeaveCallback -> IO (FunPtr C_DropTargetLeaveCallback)
mk_DropTargetLeaveCallback C_DropTargetLeaveCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetLeaveCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"leave" FunPtr C_DropTargetLeaveCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DropTargetLeaveSignalInfo
instance SignalInfo DropTargetLeaveSignalInfo where
    type HaskellCallbackType DropTargetLeaveSignalInfo = DropTargetLeaveCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DropTargetLeaveCallback cb
        cb'' <- mk_DropTargetLeaveCallback cb'
        connectSignalFunPtr obj "leave" cb'' connectMode detail

#endif

-- signal DropTarget::motion
-- | The [motion](#g:signal:motion) signal is emitted while the pointer is moving
-- over the drop target.
type DropTargetMotionCallback =
    Double
    -- ^ /@x@/: the x coordinate of the current pointer position
    -> Double
    -- ^ /@y@/: the y coordinate of the current pointer position
    -> IO [Gdk.Flags.DragAction]
    -- ^ __Returns:__ Preferred action for this drag operation or 0 if dropping is not
    --     supported at the current /@x@/,/@y@/ location.

-- | A convenience synonym for @`Nothing` :: `Maybe` `DropTargetMotionCallback`@.
noDropTargetMotionCallback :: Maybe DropTargetMotionCallback
noDropTargetMotionCallback :: Maybe DropTargetEnterCallback
noDropTargetMotionCallback = Maybe DropTargetEnterCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_DropTargetMotion :: MonadIO m => DropTargetMotionCallback -> m (GClosure C_DropTargetMotionCallback)
genClosure_DropTargetMotion :: DropTargetEnterCallback -> m (GClosure C_DropTargetEnterCallback)
genClosure_DropTargetMotion DropTargetEnterCallback
cb = IO (GClosure C_DropTargetEnterCallback)
-> m (GClosure C_DropTargetEnterCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_DropTargetEnterCallback)
 -> m (GClosure C_DropTargetEnterCallback))
-> IO (GClosure C_DropTargetEnterCallback)
-> m (GClosure C_DropTargetEnterCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_DropTargetEnterCallback
cb' = DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetMotionCallback DropTargetEnterCallback
cb
    C_DropTargetEnterCallback -> IO (FunPtr C_DropTargetEnterCallback)
mk_DropTargetMotionCallback C_DropTargetEnterCallback
cb' IO (FunPtr C_DropTargetEnterCallback)
-> (FunPtr C_DropTargetEnterCallback
    -> IO (GClosure C_DropTargetEnterCallback))
-> IO (GClosure C_DropTargetEnterCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_DropTargetEnterCallback
-> IO (GClosure C_DropTargetEnterCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `DropTargetMotionCallback` into a `C_DropTargetMotionCallback`.
wrap_DropTargetMotionCallback ::
    DropTargetMotionCallback ->
    C_DropTargetMotionCallback
wrap_DropTargetMotionCallback :: DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetMotionCallback DropTargetEnterCallback
_cb Ptr ()
_ CDouble
x CDouble
y Ptr ()
_ = do
    let x' :: Double
x' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
x
    let y' :: Double
y' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
y
    [DragAction]
result <- DropTargetEnterCallback
_cb  Double
x' Double
y'
    let result' :: CUInt
result' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
result
    CUInt -> IO CUInt
forall (m :: * -> *) a. Monad m => a -> m a
return CUInt
result'


-- | Connect a signal handler for the [motion](#signal:motion) 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' dropTarget #motion callback
-- @
-- 
-- 
onDropTargetMotion :: (IsDropTarget a, MonadIO m) => a -> DropTargetMotionCallback -> m SignalHandlerId
onDropTargetMotion :: a -> DropTargetEnterCallback -> m SignalHandlerId
onDropTargetMotion a
obj DropTargetEnterCallback
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_DropTargetEnterCallback
cb' = DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetMotionCallback DropTargetEnterCallback
cb
    FunPtr C_DropTargetEnterCallback
cb'' <- C_DropTargetEnterCallback -> IO (FunPtr C_DropTargetEnterCallback)
mk_DropTargetMotionCallback C_DropTargetEnterCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetEnterCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"motion" FunPtr C_DropTargetEnterCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [motion](#signal:motion) 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' dropTarget #motion callback
-- @
-- 
-- 
afterDropTargetMotion :: (IsDropTarget a, MonadIO m) => a -> DropTargetMotionCallback -> m SignalHandlerId
afterDropTargetMotion :: a -> DropTargetEnterCallback -> m SignalHandlerId
afterDropTargetMotion a
obj DropTargetEnterCallback
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_DropTargetEnterCallback
cb' = DropTargetEnterCallback -> C_DropTargetEnterCallback
wrap_DropTargetMotionCallback DropTargetEnterCallback
cb
    FunPtr C_DropTargetEnterCallback
cb'' <- C_DropTargetEnterCallback -> IO (FunPtr C_DropTargetEnterCallback)
mk_DropTargetMotionCallback C_DropTargetEnterCallback
cb'
    a
-> Text
-> FunPtr C_DropTargetEnterCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"motion" FunPtr C_DropTargetEnterCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DropTargetMotionSignalInfo
instance SignalInfo DropTargetMotionSignalInfo where
    type HaskellCallbackType DropTargetMotionSignalInfo = DropTargetMotionCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DropTargetMotionCallback cb
        cb'' <- mk_DropTargetMotionCallback cb'
        connectSignalFunPtr obj "motion" cb'' connectMode detail

#endif

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

-- | 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' dropTarget #actions
-- @
getDropTargetActions :: (MonadIO m, IsDropTarget o) => o -> m [Gdk.Flags.DragAction]
getDropTargetActions :: o -> m [DragAction]
getDropTargetActions o
obj = 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
$ 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' dropTarget [ #actions 'Data.GI.Base.Attributes.:=' value ]
-- @
setDropTargetActions :: (MonadIO m, IsDropTarget o) => o -> [Gdk.Flags.DragAction] -> m ()
setDropTargetActions :: o -> [DragAction] -> m ()
setDropTargetActions o
obj [DragAction]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> [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`.
constructDropTargetActions :: (IsDropTarget o, MIO.MonadIO m) => [Gdk.Flags.DragAction] -> m (GValueConstruct o)
constructDropTargetActions :: [DragAction] -> m (GValueConstruct o)
constructDropTargetActions [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
$ 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 DropTargetActionsPropertyInfo
instance AttrInfo DropTargetActionsPropertyInfo where
    type AttrAllowedOps DropTargetActionsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DropTargetActionsPropertyInfo = IsDropTarget
    type AttrSetTypeConstraint DropTargetActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferTypeConstraint DropTargetActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferType DropTargetActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrGetType DropTargetActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrLabel DropTargetActionsPropertyInfo = "actions"
    type AttrOrigin DropTargetActionsPropertyInfo = DropTarget
    attrGet = getDropTargetActions
    attrSet = setDropTargetActions
    attrTransfer _ v = do
        return v
    attrConstruct = constructDropTargetActions
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data DropTargetDropPropertyInfo
instance AttrInfo DropTargetDropPropertyInfo where
    type AttrAllowedOps DropTargetDropPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DropTargetDropPropertyInfo = IsDropTarget
    type AttrSetTypeConstraint DropTargetDropPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DropTargetDropPropertyInfo = (~) ()
    type AttrTransferType DropTargetDropPropertyInfo = ()
    type AttrGetType DropTargetDropPropertyInfo = (Maybe Gdk.Drop.Drop)
    type AttrLabel DropTargetDropPropertyInfo = "drop"
    type AttrOrigin DropTargetDropPropertyInfo = DropTarget
    attrGet = getDropTargetDrop
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "formats"
   -- Type: TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,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' dropTarget #formats
-- @
getDropTargetFormats :: (MonadIO m, IsDropTarget o) => o -> m (Maybe Gdk.ContentFormats.ContentFormats)
getDropTargetFormats :: o -> m (Maybe ContentFormats)
getDropTargetFormats o
obj = IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentFormats) -> m (Maybe ContentFormats))
-> IO (Maybe ContentFormats) -> m (Maybe 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

#if defined(ENABLE_OVERLOADING)
data DropTargetFormatsPropertyInfo
instance AttrInfo DropTargetFormatsPropertyInfo where
    type AttrAllowedOps DropTargetFormatsPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DropTargetFormatsPropertyInfo = IsDropTarget
    type AttrSetTypeConstraint DropTargetFormatsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint DropTargetFormatsPropertyInfo = (~) ()
    type AttrTransferType DropTargetFormatsPropertyInfo = ()
    type AttrGetType DropTargetFormatsPropertyInfo = (Maybe Gdk.ContentFormats.ContentFormats)
    type AttrLabel DropTargetFormatsPropertyInfo = "formats"
    type AttrOrigin DropTargetFormatsPropertyInfo = DropTarget
    attrGet = getDropTargetFormats
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "preload"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@preload@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' dropTarget [ #preload 'Data.GI.Base.Attributes.:=' value ]
-- @
setDropTargetPreload :: (MonadIO m, IsDropTarget o) => o -> Bool -> m ()
setDropTargetPreload :: o -> Bool -> m ()
setDropTargetPreload o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"preload" Bool
val

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

#if defined(ENABLE_OVERLOADING)
data DropTargetPreloadPropertyInfo
instance AttrInfo DropTargetPreloadPropertyInfo where
    type AttrAllowedOps DropTargetPreloadPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DropTargetPreloadPropertyInfo = IsDropTarget
    type AttrSetTypeConstraint DropTargetPreloadPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint DropTargetPreloadPropertyInfo = (~) Bool
    type AttrTransferType DropTargetPreloadPropertyInfo = Bool
    type AttrGetType DropTargetPreloadPropertyInfo = Bool
    type AttrLabel DropTargetPreloadPropertyInfo = "preload"
    type AttrOrigin DropTargetPreloadPropertyInfo = DropTarget
    attrGet = getDropTargetPreload
    attrSet = setDropTargetPreload
    attrTransfer _ v = do
        return v
    attrConstruct = constructDropTargetPreload
    attrClear = undefined
#endif

-- VVV Prop "value"
   -- Type: TGValue
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data DropTargetValuePropertyInfo
instance AttrInfo DropTargetValuePropertyInfo where
    type AttrAllowedOps DropTargetValuePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DropTargetValuePropertyInfo = IsDropTarget
    type AttrSetTypeConstraint DropTargetValuePropertyInfo = (~) ()
    type AttrTransferTypeConstraint DropTargetValuePropertyInfo = (~) ()
    type AttrTransferType DropTargetValuePropertyInfo = ()
    type AttrGetType DropTargetValuePropertyInfo = (Maybe GValue)
    type AttrLabel DropTargetValuePropertyInfo = "value"
    type AttrOrigin DropTargetValuePropertyInfo = DropTarget
    attrGet = getDropTargetValue
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DropTarget
type instance O.AttributeList DropTarget = DropTargetAttributeList
type DropTargetAttributeList = ('[ '("actions", DropTargetActionsPropertyInfo), '("drop", DropTargetDropPropertyInfo), '("formats", DropTargetFormatsPropertyInfo), '("name", Gtk.EventController.EventControllerNamePropertyInfo), '("preload", DropTargetPreloadPropertyInfo), '("propagationLimit", Gtk.EventController.EventControllerPropagationLimitPropertyInfo), '("propagationPhase", Gtk.EventController.EventControllerPropagationPhasePropertyInfo), '("value", DropTargetValuePropertyInfo), '("widget", Gtk.EventController.EventControllerWidgetPropertyInfo)] :: [(Symbol, *)])
#endif

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

dropTargetDrop :: AttrLabelProxy "drop"
dropTargetDrop = AttrLabelProxy

dropTargetFormats :: AttrLabelProxy "formats"
dropTargetFormats = AttrLabelProxy

dropTargetPreload :: AttrLabelProxy "preload"
dropTargetPreload = AttrLabelProxy

dropTargetValue :: AttrLabelProxy "value"
dropTargetValue = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList DropTarget = DropTargetSignalList
type DropTargetSignalList = ('[ '("accept", DropTargetAcceptSignalInfo), '("drop", DropTargetDropSignalInfo), '("enter", DropTargetEnterSignalInfo), '("leave", DropTargetLeaveSignalInfo), '("motion", DropTargetMotionSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method DropTarget::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The supported type or %G_TYPE_INVALID"
--                 , 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 supported actions"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "DropTarget" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_new" gtk_drop_target_new :: 
    CGType ->                               -- type : TBasicType TGType
    CUInt ->                                -- actions : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    IO (Ptr DropTarget)

-- | Creates a new t'GI.Gtk.Objects.DropTarget.DropTarget' object.
-- 
-- If the drop target should support more than 1 type, pass
-- @/G_TYPE_INVALID/@ for /@type@/ and then call
-- 'GI.Gtk.Objects.DropTarget.dropTargetSetGtypes'.
dropTargetNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: The supported type or @/G_TYPE_INVALID/@
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: the supported actions
    -> m DropTarget
    -- ^ __Returns:__ the new t'GI.Gtk.Objects.DropTarget.DropTarget'
dropTargetNew :: GType -> [DragAction] -> m DropTarget
dropTargetNew GType
type_ [DragAction]
actions = IO DropTarget -> m DropTarget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DropTarget -> m DropTarget) -> IO DropTarget -> m DropTarget
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    let actions' :: CUInt
actions' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
actions
    Ptr DropTarget
result <- CGType -> CUInt -> IO (Ptr DropTarget)
gtk_drop_target_new CGType
type_' CUInt
actions'
    Text -> Ptr DropTarget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dropTargetNew" Ptr DropTarget
result
    DropTarget
result' <- ((ManagedPtr DropTarget -> DropTarget)
-> Ptr DropTarget -> IO DropTarget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DropTarget -> DropTarget
DropTarget) Ptr DropTarget
result
    DropTarget -> IO DropTarget
forall (m :: * -> *) a. Monad m => a -> m a
return DropTarget
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DropTarget::get_actions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , 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 "gtk_drop_target_get_actions" gtk_drop_target_get_actions :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    IO CUInt

-- | Gets the actions that this drop target supports.
dropTargetGetActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m [Gdk.Flags.DragAction]
    -- ^ __Returns:__ the actions that this drop target supports
dropTargetGetActions :: a -> m [DragAction]
dropTargetGetActions a
self = 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 DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr DropTarget -> IO CUInt
gtk_drop_target_get_actions Ptr DropTarget
self'
    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
self
    [DragAction] -> IO [DragAction]
forall (m :: * -> *) a. Monad m => a -> m a
return [DragAction]
result'

#if defined(ENABLE_OVERLOADING)
data DropTargetGetActionsMethodInfo
instance (signature ~ (m [Gdk.Flags.DragAction]), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetGetActionsMethodInfo a signature where
    overloadedMethod = dropTargetGetActions

#endif

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

foreign import ccall "gtk_drop_target_get_drop" gtk_drop_target_get_drop :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    IO (Ptr Gdk.Drop.Drop)

-- | Gets the currently handled drop operation.
-- 
-- If no drop operation is going on, 'P.Nothing' is returned.
dropTargetGetDrop ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m (Maybe Gdk.Drop.Drop)
    -- ^ __Returns:__ The current drop
dropTargetGetDrop :: a -> m (Maybe Drop)
dropTargetGetDrop a
self = IO (Maybe Drop) -> m (Maybe Drop)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Drop) -> m (Maybe Drop))
-> IO (Maybe Drop) -> m (Maybe Drop)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Drop
result <- Ptr DropTarget -> IO (Ptr Drop)
gtk_drop_target_get_drop Ptr DropTarget
self'
    Maybe Drop
maybeResult <- Ptr Drop -> (Ptr Drop -> IO Drop) -> IO (Maybe Drop)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Drop
result ((Ptr Drop -> IO Drop) -> IO (Maybe Drop))
-> (Ptr Drop -> IO Drop) -> IO (Maybe Drop)
forall a b. (a -> b) -> a -> b
$ \Ptr Drop
result' -> do
        Drop
result'' <- ((ManagedPtr Drop -> Drop) -> Ptr Drop -> IO Drop
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drop -> Drop
Gdk.Drop.Drop) Ptr Drop
result'
        Drop -> IO Drop
forall (m :: * -> *) a. Monad m => a -> m a
return Drop
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Drop -> IO (Maybe Drop)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drop
maybeResult

#if defined(ENABLE_OVERLOADING)
data DropTargetGetDropMethodInfo
instance (signature ~ (m (Maybe Gdk.Drop.Drop)), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetGetDropMethodInfo a signature where
    overloadedMethod = dropTargetGetDrop

#endif

-- method DropTarget::get_formats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , 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 "gtk_drop_target_get_formats" gtk_drop_target_get_formats :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    IO (Ptr Gdk.ContentFormats.ContentFormats)

-- | Gets the data formats that this drop target accepts.
-- 
-- If the result is 'P.Nothing', all formats are expected to be supported.
dropTargetGetFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m (Maybe Gdk.ContentFormats.ContentFormats)
    -- ^ __Returns:__ the supported data formats
dropTargetGetFormats :: a -> m (Maybe ContentFormats)
dropTargetGetFormats a
self = IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentFormats) -> m (Maybe ContentFormats))
-> IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ContentFormats
result <- Ptr DropTarget -> IO (Ptr ContentFormats)
gtk_drop_target_get_formats Ptr DropTarget
self'
    Maybe ContentFormats
maybeResult <- Ptr ContentFormats
-> (Ptr ContentFormats -> IO ContentFormats)
-> IO (Maybe ContentFormats)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ContentFormats
result ((Ptr ContentFormats -> IO ContentFormats)
 -> IO (Maybe ContentFormats))
-> (Ptr ContentFormats -> IO ContentFormats)
-> IO (Maybe ContentFormats)
forall a b. (a -> b) -> a -> b
$ \Ptr ContentFormats
result' -> do
        ContentFormats
result'' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats) Ptr ContentFormats
result'
        ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ContentFormats -> IO (Maybe ContentFormats)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ContentFormats
maybeResult

#if defined(ENABLE_OVERLOADING)
data DropTargetGetFormatsMethodInfo
instance (signature ~ (m (Maybe Gdk.ContentFormats.ContentFormats)), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetGetFormatsMethodInfo a signature where
    overloadedMethod = dropTargetGetFormats

#endif

-- method DropTarget::get_gtypes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_types"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "optional pointer to take the\n    number of #GTypes contained in the return value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_types"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "optional pointer to take the\n    number of #GTypes contained in the return value"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TGType))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_get_gtypes" gtk_drop_target_get_gtypes :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    Ptr Word64 ->                           -- n_types : TBasicType TUInt64
    IO (Ptr CGType)

-- | Gets the list of supported @/GTypes/@ for /@self@/. If no type have been set,
-- 'P.Nothing' will be returned.
dropTargetGetGtypes ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m (Maybe [GType])
    -- ^ __Returns:__ 
    --      @/G_TYPE_INVALID/@-terminated array of types included in /@formats@/ or
    --      'P.Nothing' if none.
dropTargetGetGtypes :: a -> m (Maybe [GType])
dropTargetGetGtypes a
self = IO (Maybe [GType]) -> m (Maybe [GType])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [GType]) -> m (Maybe [GType]))
-> IO (Maybe [GType]) -> m (Maybe [GType])
forall a b. (a -> b) -> a -> b
$ do
    Ptr DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CGType
nTypes <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CGType
result <- Ptr DropTarget -> Ptr CGType -> IO (Ptr CGType)
gtk_drop_target_get_gtypes Ptr DropTarget
self' Ptr CGType
nTypes
    CGType
nTypes' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
nTypes
    Maybe [GType]
maybeResult <- Ptr CGType -> (Ptr CGType -> IO [GType]) -> IO (Maybe [GType])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CGType
result ((Ptr CGType -> IO [GType]) -> IO (Maybe [GType]))
-> (Ptr CGType -> IO [GType]) -> IO (Maybe [GType])
forall a b. (a -> b) -> a -> b
$ \Ptr CGType
result' -> do
        [GType]
result'' <- ((CGType -> GType) -> CGType -> Ptr CGType -> IO [GType]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CGType -> GType
GType CGType
nTypes') Ptr CGType
result'
        [GType] -> IO [GType]
forall (m :: * -> *) a. Monad m => a -> m a
return [GType]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
nTypes
    Maybe [GType] -> IO (Maybe [GType])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [GType]
maybeResult

#if defined(ENABLE_OVERLOADING)
data DropTargetGetGtypesMethodInfo
instance (signature ~ (m (Maybe [GType])), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetGetGtypesMethodInfo a signature where
    overloadedMethod = dropTargetGetGtypes

#endif

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

foreign import ccall "gtk_drop_target_get_preload" gtk_drop_target_get_preload :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    IO CInt

-- | Gets the value of the GtkDropTarget:preload property.
dropTargetGetPreload ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if drop data should be preloaded
dropTargetGetPreload :: a -> m Bool
dropTargetGetPreload a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr DropTarget -> IO CInt
gtk_drop_target_get_preload Ptr DropTarget
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data DropTargetGetPreloadMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetGetPreloadMethodInfo a signature where
    overloadedMethod = dropTargetGetPreload

#endif

-- method DropTarget::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_get_value" gtk_drop_target_get_value :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    IO (Ptr GValue)

-- | Gets the value of the GtkDropTarget:value porperty.
dropTargetGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m (Maybe GValue)
    -- ^ __Returns:__ The current drop data
dropTargetGetValue :: a -> m (Maybe GValue)
dropTargetGetValue a
self = IO (Maybe GValue) -> m (Maybe GValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GValue
result <- Ptr DropTarget -> IO (Ptr GValue)
gtk_drop_target_get_value Ptr DropTarget
self'
    Maybe GValue
maybeResult <- Ptr GValue -> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GValue
result ((Ptr GValue -> IO GValue) -> IO (Maybe GValue))
-> (Ptr GValue -> IO GValue) -> IO (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ \Ptr GValue
result' -> do
        GValue
result'' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result'
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe GValue -> IO (Maybe GValue)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GValue
maybeResult

#if defined(ENABLE_OVERLOADING)
data DropTargetGetValueMethodInfo
instance (signature ~ (m (Maybe GValue)), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetGetValueMethodInfo a signature where
    overloadedMethod = dropTargetGetValue

#endif

-- method DropTarget::reject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_reject" gtk_drop_target_reject :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    IO ()

-- | Rejects the ongoing drop operation.
-- 
-- If no drop operation is ongoing - when GdkDropTarget:drop
-- returns 'P.Nothing' - this function does nothing.
-- 
-- This function should be used when delaying the decision
-- on whether to accept a drag or not until after reading
-- the data.
dropTargetReject ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> m ()
dropTargetReject :: a -> m ()
dropTargetReject a
self = 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 DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr DropTarget -> IO ()
gtk_drop_target_reject Ptr DropTarget
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DropTargetRejectMethodInfo
instance (signature ~ (m ()), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetRejectMethodInfo a signature where
    overloadedMethod = dropTargetReject

#endif

-- method DropTarget::set_actions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , 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 supported actions"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_set_actions" gtk_drop_target_set_actions :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    CUInt ->                                -- actions : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    IO ()

-- | Sets the actions that this drop target supports.
dropTargetSetActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: the supported actions
    -> m ()
dropTargetSetActions :: a -> [DragAction] -> m ()
dropTargetSetActions a
self [DragAction]
actions = 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 DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let actions' :: CUInt
actions' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
actions
    Ptr DropTarget -> CUInt -> IO ()
gtk_drop_target_set_actions Ptr DropTarget
self' CUInt
actions'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DropTargetSetActionsMethodInfo
instance (signature ~ ([Gdk.Flags.DragAction] -> m ()), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetSetActionsMethodInfo a signature where
    overloadedMethod = dropTargetSetActions

#endif

-- method DropTarget::set_gtypes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "types"
--           , argType = TCArray False (-1) 2 (TBasicType TGType)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "\n    all supported #GTypes that can be dropped"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_types"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of @types" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_types"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of @types" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_set_gtypes" gtk_drop_target_set_gtypes :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    Ptr CGType ->                           -- types : TCArray False (-1) 2 (TBasicType TGType)
    Word64 ->                               -- n_types : TBasicType TUInt64
    IO ()

-- | Sets the supported @/GTypes/@ for this drop target.
-- 
-- The GtkDropTarget[drop](#g:signal:drop) signal will
dropTargetSetGtypes ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> Maybe ([GType])
    -- ^ /@types@/: 
    --     all supported @/GTypes/@ that can be dropped
    -> m ()
dropTargetSetGtypes :: a -> Maybe [GType] -> m ()
dropTargetSetGtypes a
self Maybe [GType]
types = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let nTypes :: CGType
nTypes = case Maybe [GType]
types of
            Maybe [GType]
Nothing -> CGType
0
            Just [GType]
jTypes -> Int -> CGType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CGType) -> Int -> CGType
forall a b. (a -> b) -> a -> b
$ [GType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GType]
jTypes
    Ptr DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CGType
maybeTypes <- case Maybe [GType]
types of
        Maybe [GType]
Nothing -> Ptr CGType -> IO (Ptr CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CGType
forall a. Ptr a
nullPtr
        Just [GType]
jTypes -> do
            Ptr CGType
jTypes' <- ((GType -> CGType) -> [GType] -> IO (Ptr CGType)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray GType -> CGType
gtypeToCGType) [GType]
jTypes
            Ptr CGType -> IO (Ptr CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CGType
jTypes'
    Ptr DropTarget -> Ptr CGType -> CGType -> IO ()
gtk_drop_target_set_gtypes Ptr DropTarget
self' Ptr CGType
maybeTypes CGType
nTypes
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
maybeTypes
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DropTargetSetGtypesMethodInfo
instance (signature ~ (Maybe ([GType]) -> m ()), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetSetGtypesMethodInfo a signature where
    overloadedMethod = dropTargetSetGtypes

#endif

-- method DropTarget::set_preload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "DropTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkDropTarget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "preload"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to preload drop data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_drop_target_set_preload" gtk_drop_target_set_preload :: 
    Ptr DropTarget ->                       -- self : TInterface (Name {namespace = "Gtk", name = "DropTarget"})
    CInt ->                                 -- preload : TBasicType TBoolean
    IO ()

-- | Sets the GtkDropTarget:preload property.
dropTargetSetPreload ::
    (B.CallStack.HasCallStack, MonadIO m, IsDropTarget a) =>
    a
    -- ^ /@self@/: a t'GI.Gtk.Objects.DropTarget.DropTarget'
    -> Bool
    -- ^ /@preload@/: 'P.True' to preload drop data
    -> m ()
dropTargetSetPreload :: a -> Bool -> m ()
dropTargetSetPreload a
self Bool
preload = 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 DropTarget
self' <- a -> IO (Ptr DropTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let preload' :: CInt
preload' = (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
preload
    Ptr DropTarget -> CInt -> IO ()
gtk_drop_target_set_preload Ptr DropTarget
self' CInt
preload'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DropTargetSetPreloadMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsDropTarget a) => O.MethodInfo DropTargetSetPreloadMethodInfo a signature where
    overloadedMethod = dropTargetSetPreload

#endif