{-# LANGUAGE TypeApplications #-}


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

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

module GI.Gdk.Objects.Drop
    ( 

-- * Exported types
    Drop(..)                                ,
    IsDrop                                  ,
    toDrop                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [finish]("GI.Gdk.Objects.Drop#g:method:finish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [readAsync]("GI.Gdk.Objects.Drop#g:method:readAsync"), [readFinish]("GI.Gdk.Objects.Drop#g:method:readFinish"), [readValueAsync]("GI.Gdk.Objects.Drop#g:method:readValueAsync"), [readValueFinish]("GI.Gdk.Objects.Drop#g:method:readValueFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [status]("GI.Gdk.Objects.Drop#g:method:status"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActions]("GI.Gdk.Objects.Drop#g:method:getActions"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDevice]("GI.Gdk.Objects.Drop#g:method:getDevice"), [getDisplay]("GI.Gdk.Objects.Drop#g:method:getDisplay"), [getDrag]("GI.Gdk.Objects.Drop#g:method:getDrag"), [getFormats]("GI.Gdk.Objects.Drop#g:method:getFormats"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSurface]("GI.Gdk.Objects.Drop#g:method:getSurface").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveDropMethod                       ,
#endif

-- ** finish #method:finish#

#if defined(ENABLE_OVERLOADING)
    DropFinishMethodInfo                    ,
#endif
    dropFinish                              ,


-- ** getActions #method:getActions#

#if defined(ENABLE_OVERLOADING)
    DropGetActionsMethodInfo                ,
#endif
    dropGetActions                          ,


-- ** getDevice #method:getDevice#

#if defined(ENABLE_OVERLOADING)
    DropGetDeviceMethodInfo                 ,
#endif
    dropGetDevice                           ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    DropGetDisplayMethodInfo                ,
#endif
    dropGetDisplay                          ,


-- ** getDrag #method:getDrag#

#if defined(ENABLE_OVERLOADING)
    DropGetDragMethodInfo                   ,
#endif
    dropGetDrag                             ,


-- ** getFormats #method:getFormats#

#if defined(ENABLE_OVERLOADING)
    DropGetFormatsMethodInfo                ,
#endif
    dropGetFormats                          ,


-- ** getSurface #method:getSurface#

#if defined(ENABLE_OVERLOADING)
    DropGetSurfaceMethodInfo                ,
#endif
    dropGetSurface                          ,


-- ** readAsync #method:readAsync#

#if defined(ENABLE_OVERLOADING)
    DropReadAsyncMethodInfo                 ,
#endif
    dropReadAsync                           ,


-- ** readFinish #method:readFinish#

#if defined(ENABLE_OVERLOADING)
    DropReadFinishMethodInfo                ,
#endif
    dropReadFinish                          ,


-- ** readValueAsync #method:readValueAsync#

#if defined(ENABLE_OVERLOADING)
    DropReadValueAsyncMethodInfo            ,
#endif
    dropReadValueAsync                      ,


-- ** readValueFinish #method:readValueFinish#

#if defined(ENABLE_OVERLOADING)
    DropReadValueFinishMethodInfo           ,
#endif
    dropReadValueFinish                     ,


-- ** status #method:status#

#if defined(ENABLE_OVERLOADING)
    DropStatusMethodInfo                    ,
#endif
    dropStatus                              ,




 -- * Properties


-- ** actions #attr:actions#
-- | The possible actions for this drop

#if defined(ENABLE_OVERLOADING)
    DropActionsPropertyInfo                 ,
#endif
    constructDropActions                    ,
#if defined(ENABLE_OVERLOADING)
    dropActions                             ,
#endif
    getDropActions                          ,


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

#if defined(ENABLE_OVERLOADING)
    DropDevicePropertyInfo                  ,
#endif
    constructDropDevice                     ,
#if defined(ENABLE_OVERLOADING)
    dropDevice                              ,
#endif
    getDropDevice                           ,


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

#if defined(ENABLE_OVERLOADING)
    DropDisplayPropertyInfo                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    dropDisplay                             ,
#endif
    getDropDisplay                          ,


-- ** drag #attr:drag#
-- | The t'GI.Gdk.Objects.Drag.Drag' that initiated this drop

#if defined(ENABLE_OVERLOADING)
    DropDragPropertyInfo                    ,
#endif
    constructDropDrag                       ,
#if defined(ENABLE_OVERLOADING)
    dropDrag                                ,
#endif
    getDropDrag                             ,


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

#if defined(ENABLE_OVERLOADING)
    DropFormatsPropertyInfo                 ,
#endif
    constructDropFormats                    ,
#if defined(ENABLE_OVERLOADING)
    dropFormats                             ,
#endif
    getDropFormats                          ,


-- ** surface #attr:surface#
-- | The t'GI.Gdk.Objects.Surface.Surface' the drop happens on

#if defined(ENABLE_OVERLOADING)
    DropSurfacePropertyInfo                 ,
#endif
    constructDropSurface                    ,
#if defined(ENABLE_OVERLOADING)
    dropSurface                             ,
#endif
    getDropSurface                          ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Drag as Gdk.Drag
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream

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

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

foreign import ccall "gdk_drop_get_type"
    c_gdk_drop_get_type :: IO B.Types.GType

instance B.Types.TypedObject Drop where
    glibType :: IO GType
glibType = IO GType
c_gdk_drop_get_type

instance B.Types.GObject Drop

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDropMethod (t :: Symbol) (o :: *) :: * where
    ResolveDropMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDropMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDropMethod "finish" o = DropFinishMethodInfo
    ResolveDropMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDropMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDropMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDropMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDropMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDropMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDropMethod "readAsync" o = DropReadAsyncMethodInfo
    ResolveDropMethod "readFinish" o = DropReadFinishMethodInfo
    ResolveDropMethod "readValueAsync" o = DropReadValueAsyncMethodInfo
    ResolveDropMethod "readValueFinish" o = DropReadValueFinishMethodInfo
    ResolveDropMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDropMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDropMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDropMethod "status" o = DropStatusMethodInfo
    ResolveDropMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDropMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDropMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDropMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDropMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDropMethod "getActions" o = DropGetActionsMethodInfo
    ResolveDropMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDropMethod "getDevice" o = DropGetDeviceMethodInfo
    ResolveDropMethod "getDisplay" o = DropGetDisplayMethodInfo
    ResolveDropMethod "getDrag" o = DropGetDragMethodInfo
    ResolveDropMethod "getFormats" o = DropGetFormatsMethodInfo
    ResolveDropMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDropMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDropMethod "getSurface" o = DropGetSurfaceMethodInfo
    ResolveDropMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDropMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDropMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDropMethod l o = O.MethodResolutionFailed l o

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

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

#endif

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

#endif

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

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

-- | 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`.
constructDropActions :: (IsDrop o, MIO.MonadIO m) => [Gdk.Flags.DragAction] -> m (GValueConstruct o)
constructDropActions :: forall o (m :: * -> *).
(IsDrop o, MonadIO m) =>
[DragAction] -> m (GValueConstruct o)
constructDropActions [DragAction]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [DragAction] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"actions" [DragAction]
val

#if defined(ENABLE_OVERLOADING)
data DropActionsPropertyInfo
instance AttrInfo DropActionsPropertyInfo where
    type AttrAllowedOps DropActionsPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint DropActionsPropertyInfo = IsDrop
    type AttrSetTypeConstraint DropActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferTypeConstraint DropActionsPropertyInfo = (~) [Gdk.Flags.DragAction]
    type AttrTransferType DropActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrGetType DropActionsPropertyInfo = [Gdk.Flags.DragAction]
    type AttrLabel DropActionsPropertyInfo = "actions"
    type AttrOrigin DropActionsPropertyInfo = Drop
    attrGet = getDropActions
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructDropActions
    attrClear = undefined
#endif

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

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

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

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data DropDragPropertyInfo
instance AttrInfo DropDragPropertyInfo where
    type AttrAllowedOps DropDragPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint DropDragPropertyInfo = IsDrop
    type AttrSetTypeConstraint DropDragPropertyInfo = Gdk.Drag.IsDrag
    type AttrTransferTypeConstraint DropDragPropertyInfo = Gdk.Drag.IsDrag
    type AttrTransferType DropDragPropertyInfo = Gdk.Drag.Drag
    type AttrGetType DropDragPropertyInfo = (Maybe Gdk.Drag.Drag)
    type AttrLabel DropDragPropertyInfo = "drag"
    type AttrOrigin DropDragPropertyInfo = Drop
    attrGet = getDropDrag
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Drag.Drag v
    attrConstruct = constructDropDrag
    attrClear = undefined
#endif

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

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Drop
type instance O.AttributeList Drop = DropAttributeList
type DropAttributeList = ('[ '("actions", DropActionsPropertyInfo), '("device", DropDevicePropertyInfo), '("display", DropDisplayPropertyInfo), '("drag", DropDragPropertyInfo), '("formats", DropFormatsPropertyInfo), '("surface", DropSurfacePropertyInfo)] :: [(Symbol, *)])
#endif

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

dropDevice :: AttrLabelProxy "device"
dropDevice = AttrLabelProxy

dropDisplay :: AttrLabelProxy "display"
dropDisplay = AttrLabelProxy

dropDrag :: AttrLabelProxy "drag"
dropDrag = AttrLabelProxy

dropFormats :: AttrLabelProxy "formats"
dropFormats = AttrLabelProxy

dropSurface :: AttrLabelProxy "surface"
dropSurface = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Drop = DropSignalList
type DropSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Drop::finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the action performed by the destination or 0 if the drop\n    failed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_drop_finish" gdk_drop_finish :: 
    Ptr Drop ->                             -- self : TInterface (Name {namespace = "Gdk", name = "Drop"})
    CUInt ->                                -- action : TInterface (Name {namespace = "Gdk", name = "DragAction"})
    IO ()

-- | Ends the drag operation after a drop.
-- 
-- The /@action@/ must be a single action selected from the actions
-- available via 'GI.Gdk.Objects.Drop.dropGetActions'.
dropFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> [Gdk.Flags.DragAction]
    -- ^ /@action@/: the action performed by the destination or 0 if the drop
    --     failed
    -> m ()
dropFinish :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> [DragAction] -> m ()
dropFinish a
self [DragAction]
action = 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 Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let action' :: CUInt
action' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
action
    Ptr Drop -> CUInt -> IO ()
gdk_drop_finish Ptr Drop
self' CUInt
action'
    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 DropFinishMethodInfo
instance (signature ~ ([Gdk.Flags.DragAction] -> m ()), MonadIO m, IsDrop a) => O.OverloadedMethod DropFinishMethodInfo a signature where
    overloadedMethod = dropFinish

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


#endif

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

foreign import ccall "gdk_drop_get_actions" gdk_drop_get_actions :: 
    Ptr Drop ->                             -- self : TInterface (Name {namespace = "Gdk", name = "Drop"})
    IO CUInt

-- | Returns the possible actions for this t'GI.Gdk.Objects.Drop.Drop'. If this value
-- contains multiple actions - ie 'GI.Gdk.Functions.dragActionIsUnique'
-- returns 'P.False' for the result - 'GI.Gdk.Objects.Drop.dropFinish' must choose
-- the action to use when accepting the drop. This will only
-- happen if you passed 'GI.Gdk.Flags.DragActionAsk' as one of the possible
-- actions in 'GI.Gdk.Objects.Drop.dropStatus'. 'GI.Gdk.Flags.DragActionAsk' itself will not
-- be included in the actions returned by this function.
-- 
-- This value may change over the lifetime of the t'GI.Gdk.Objects.Drop.Drop' both
-- as a response to source side actions as well as to calls to
-- 'GI.Gdk.Objects.Drop.dropStatus' or 'GI.Gdk.Objects.Drop.dropFinish'. The source side will
-- not change this value anymore once a drop has started.
dropGetActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> m [Gdk.Flags.DragAction]
    -- ^ __Returns:__ The possible @/GdkDragActions/@
dropGetActions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> m [DragAction]
dropGetActions 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 Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Drop -> IO CUInt
gdk_drop_get_actions Ptr Drop
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 DropGetActionsMethodInfo
instance (signature ~ (m [Gdk.Flags.DragAction]), MonadIO m, IsDrop a) => O.OverloadedMethod DropGetActionsMethodInfo a signature where
    overloadedMethod = dropGetActions

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


#endif

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

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

-- | Returns the t'GI.Gdk.Objects.Device.Device' performing the drop.
dropGetDevice ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> m Gdk.Device.Device
    -- ^ __Returns:__ The t'GI.Gdk.Objects.Device.Device' performing the drop.
dropGetDevice :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> m Device
dropGetDevice a
self = IO Device -> m Device
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Device -> m Device) -> IO Device -> m Device
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Device
result <- Ptr Drop -> IO (Ptr Device)
gdk_drop_get_device Ptr Drop
self'
    Text -> Ptr Device -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dropGetDevice" Ptr Device
result
    Device
result' <- ((ManagedPtr Device -> Device) -> Ptr Device -> IO Device
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Device -> Device
Gdk.Device.Device) Ptr Device
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Device -> IO Device
forall (m :: * -> *) a. Monad m => a -> m a
return Device
result'

#if defined(ENABLE_OVERLOADING)
data DropGetDeviceMethodInfo
instance (signature ~ (m Gdk.Device.Device), MonadIO m, IsDrop a) => O.OverloadedMethod DropGetDeviceMethodInfo a signature where
    overloadedMethod = dropGetDevice

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


#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data DropGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsDrop a) => O.OverloadedMethod DropGetDisplayMethodInfo a signature where
    overloadedMethod = dropGetDisplay

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


#endif

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

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

-- | If this is an in-app drag-and-drop operation, returns the t'GI.Gdk.Objects.Drag.Drag'
-- that corresponds to this drop.
-- 
-- If it is not, 'P.Nothing' is returned.
dropGetDrag ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> m (Maybe Gdk.Drag.Drag)
    -- ^ __Returns:__ the corresponding t'GI.Gdk.Objects.Drag.Drag'
dropGetDrag :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> m (Maybe Drag)
dropGetDrag a
self = IO (Maybe Drag) -> m (Maybe Drag)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Drag) -> m (Maybe Drag))
-> IO (Maybe Drag) -> m (Maybe Drag)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Drag
result <- Ptr Drop -> IO (Ptr Drag)
gdk_drop_get_drag Ptr Drop
self'
    Maybe Drag
maybeResult <- Ptr Drag -> (Ptr Drag -> IO Drag) -> IO (Maybe Drag)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Drag
result ((Ptr Drag -> IO Drag) -> IO (Maybe Drag))
-> (Ptr Drag -> IO Drag) -> IO (Maybe Drag)
forall a b. (a -> b) -> a -> b
$ \Ptr Drag
result' -> do
        Drag
result'' <- ((ManagedPtr Drag -> Drag) -> Ptr Drag -> IO Drag
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drag -> Drag
Gdk.Drag.Drag) Ptr Drag
result'
        Drag -> IO Drag
forall (m :: * -> *) a. Monad m => a -> m a
return Drag
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Drag -> IO (Maybe Drag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drag
maybeResult

#if defined(ENABLE_OVERLOADING)
data DropGetDragMethodInfo
instance (signature ~ (m (Maybe Gdk.Drag.Drag)), MonadIO m, IsDrop a) => O.OverloadedMethod DropGetDragMethodInfo a signature where
    overloadedMethod = dropGetDrag

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


#endif

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

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

-- | Returns the t'GI.Gdk.Structs.ContentFormats.ContentFormats' that the drop offers the data
-- to be read in.
dropGetFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> m Gdk.ContentFormats.ContentFormats
    -- ^ __Returns:__ The possible t'GI.Gdk.Structs.ContentFormats.ContentFormats'
dropGetFormats :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> m ContentFormats
dropGetFormats a
self = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ContentFormats
result <- Ptr Drop -> IO (Ptr ContentFormats)
gdk_drop_get_formats Ptr Drop
self'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dropGetFormats" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ContentFormats -> ContentFormats
Gdk.ContentFormats.ContentFormats) Ptr ContentFormats
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data DropGetFormatsMethodInfo
instance (signature ~ (m Gdk.ContentFormats.ContentFormats), MonadIO m, IsDrop a) => O.OverloadedMethod DropGetFormatsMethodInfo a signature where
    overloadedMethod = dropGetFormats

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


#endif

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

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

-- | Returns the t'GI.Gdk.Objects.Surface.Surface' performing the drop.
dropGetSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> m Gdk.Surface.Surface
    -- ^ __Returns:__ The t'GI.Gdk.Objects.Surface.Surface' performing the drop.
dropGetSurface :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> m Surface
dropGetSurface a
self = IO Surface -> m Surface
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Surface -> m Surface) -> IO Surface -> m Surface
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Surface
result <- Ptr Drop -> IO (Ptr Surface)
gdk_drop_get_surface Ptr Drop
self'
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dropGetSurface" Ptr Surface
result
    Surface
result' <- ((ManagedPtr Surface -> Surface) -> Ptr Surface -> IO Surface
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Surface -> Surface
Gdk.Surface.Surface) Ptr Surface
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data DropGetSurfaceMethodInfo
instance (signature ~ (m Gdk.Surface.Surface), MonadIO m, IsDrop a) => O.OverloadedMethod DropGetSurfaceMethodInfo a signature where
    overloadedMethod = dropGetSurface

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


#endif

-- method Drop::read_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_types"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "\n    pointer to an array of mime types"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the io priority for the read operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GAsyncReadyCallback to call when\n    the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_drop_read_async" gdk_drop_read_async :: 
    Ptr Drop ->                             -- self : TInterface (Name {namespace = "Gdk", name = "Drop"})
    Ptr CString ->                          -- mime_types : TCArray True (-1) (-1) (TBasicType TUTF8)
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously read the dropped data from a t'GI.Gdk.Objects.Drop.Drop'
-- in a format that complies with one of the mime types.
dropReadAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> [T.Text]
    -- ^ /@mimeTypes@/: 
    --     pointer to an array of mime types
    -> Int32
    -- ^ /@ioPriority@/: the io priority for the read operation
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when
    --     the request is satisfied
    -> m ()
dropReadAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDrop a, IsCancellable b) =>
a -> [Text] -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
dropReadAsync a
self [Text]
mimeTypes Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
mimeTypes' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
mimeTypes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Drop
-> Ptr CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gdk_drop_read_async Ptr Drop
self' Ptr CString
mimeTypes' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
mimeTypes'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
mimeTypes'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DropReadAsyncMethodInfo
instance (signature ~ ([T.Text] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDrop a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DropReadAsyncMethodInfo a signature where
    overloadedMethod = dropReadAsync

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


#endif

-- method Drop::read_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the used mime type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_drop_read_finish" gdk_drop_read_finish :: 
    Ptr Drop ->                             -- self : TInterface (Name {namespace = "Gdk", name = "Drop"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CString ->                          -- out_mime_type : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream.InputStream)

-- | Finishes an async drop read operation, see 'GI.Gdk.Objects.Drop.dropReadAsync'.
dropReadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ((Maybe Gio.InputStream.InputStream, T.Text))
    -- ^ __Returns:__ the t'GI.Gio.Objects.InputStream.InputStream', or 'P.Nothing' /(Can throw 'Data.GI.Base.GError.GError')/
dropReadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDrop a, IsAsyncResult b) =>
a -> b -> m (Maybe InputStream, Text)
dropReadFinish a
self b
result_ = IO (Maybe InputStream, Text) -> m (Maybe InputStream, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InputStream, Text) -> m (Maybe InputStream, Text))
-> IO (Maybe InputStream, Text) -> m (Maybe InputStream, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr CString
outMimeType <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (Maybe InputStream, Text)
-> IO () -> IO (Maybe InputStream, Text)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr InputStream
result <- (Ptr (Ptr GError) -> IO (Ptr InputStream)) -> IO (Ptr InputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr InputStream))
 -> IO (Ptr InputStream))
-> (Ptr (Ptr GError) -> IO (Ptr InputStream))
-> IO (Ptr InputStream)
forall a b. (a -> b) -> a -> b
$ Ptr Drop
-> Ptr AsyncResult
-> Ptr CString
-> Ptr (Ptr GError)
-> IO (Ptr InputStream)
gdk_drop_read_finish Ptr Drop
self' Ptr AsyncResult
result_' Ptr CString
outMimeType
        Maybe InputStream
maybeResult <- Ptr InputStream
-> (Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr InputStream
result ((Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream))
-> (Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream)
forall a b. (a -> b) -> a -> b
$ \Ptr InputStream
result' -> do
            InputStream
result'' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result'
            InputStream -> IO InputStream
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result''
        CString
outMimeType' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outMimeType
        Text
outMimeType'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outMimeType'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outMimeType'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outMimeType
        (Maybe InputStream, Text) -> IO (Maybe InputStream, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe InputStream
maybeResult, Text
outMimeType'')
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outMimeType
     )

#if defined(ENABLE_OVERLOADING)
data DropReadFinishMethodInfo
instance (signature ~ (b -> m ((Maybe Gio.InputStream.InputStream, T.Text))), MonadIO m, IsDrop a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DropReadFinishMethodInfo a signature where
    overloadedMethod = dropReadFinish

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


#endif

-- method Drop::read_value_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GType to read" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority]\n    of the request."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "callback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_drop_read_value_async" gdk_drop_read_value_async :: 
    Ptr Drop ->                             -- self : TInterface (Name {namespace = "Gdk", name = "Drop"})
    CGType ->                               -- type : TBasicType TGType
    Int32 ->                                -- io_priority : TBasicType TInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously request the drag operation\'s contents converted to the given
-- /@type@/. When the operation is finished /@callback@/ will be called.
-- You can then call 'GI.Gdk.Objects.Drop.dropReadValueFinish' to get the resulting
-- t'GI.GObject.Structs.Value.Value'.
-- 
-- For local drag\'n\'drop operations that are available in the given t'GType', the
-- value will be copied directly. Otherwise, GDK will try to use
-- 'GI.Gdk.Functions.contentDeserializeAsync' to convert the data.
dropReadValueAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> GType
    -- ^ /@type@/: a t'GType' to read
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority]
    --     of the request.
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
dropReadValueAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDrop a, IsCancellable b) =>
a -> GType -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
dropReadValueAsync a
self GType
type_ Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = 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 Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Drop
-> CGType
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gdk_drop_read_value_async Ptr Drop
self' CGType
type_' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DropReadValueAsyncMethodInfo
instance (signature ~ (GType -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsDrop a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod DropReadValueAsyncMethodInfo a signature where
    overloadedMethod = dropReadValueAsync

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


#endif

-- method Drop::read_value_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrop" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : True
-- Skip return : False

foreign import ccall "gdk_drop_read_value_finish" gdk_drop_read_value_finish :: 
    Ptr Drop ->                             -- self : TInterface (Name {namespace = "Gdk", name = "Drop"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GValue)

-- | Finishes an async drop read started with
-- 'GI.Gdk.Objects.Drop.dropReadValueAsync'.
dropReadValueFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m GValue
    -- ^ __Returns:__ a t'GI.GObject.Structs.Value.Value' containing the result. /(Can throw 'Data.GI.Base.GError.GError')/
dropReadValueFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDrop a, IsAsyncResult b) =>
a -> b -> m GValue
dropReadValueFinish a
self b
result_ = IO GValue -> m GValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Drop
self' <- a -> IO (Ptr Drop)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO GValue -> IO () -> IO GValue
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GValue
result <- (Ptr (Ptr GError) -> IO (Ptr GValue)) -> IO (Ptr GValue)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GValue)) -> IO (Ptr GValue))
-> (Ptr (Ptr GError) -> IO (Ptr GValue)) -> IO (Ptr GValue)
forall a b. (a -> b) -> a -> b
$ Ptr Drop -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr GValue)
gdk_drop_read_value_finish Ptr Drop
self' Ptr AsyncResult
result_'
        Text -> Ptr GValue -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"dropReadValueFinish" Ptr GValue
result
        GValue
result' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data DropReadValueFinishMethodInfo
instance (signature ~ (b -> m GValue), MonadIO m, IsDrop a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod DropReadValueFinishMethodInfo a signature where
    overloadedMethod = dropReadValueFinish

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


#endif

-- method Drop::status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Drop" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkDrop" , 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
--                       "Supported actions of the destination, or 0 to indicate\n   that a drop will not be accepted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "preferred"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DragAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A unique action that's a member of @actions indicating the\n   preferred action."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Selects all actions that are potentially supported by the destination.
-- 
-- When calling this function, do not restrict the passed in actions to
-- the ones provided by 'GI.Gdk.Objects.Drop.dropGetActions'. Those actions may
-- change in the future, even depending on the actions you provide here.
-- 
-- The /@preferred@/ action is a hint to the drag\'n\'drop mechanism about which
-- action to use when multiple actions are possible.
-- 
-- This function should be called by drag destinations in response to
-- 'GI.Gdk.Enums.EventTypeDragEnter' or 'GI.Gdk.Enums.EventTypeDragMotion' events. If the destination does
-- not yet know the exact actions it supports, it should set any possible
-- actions first and then later call this function again.
dropStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsDrop a) =>
    a
    -- ^ /@self@/: a t'GI.Gdk.Objects.Drop.Drop'
    -> [Gdk.Flags.DragAction]
    -- ^ /@actions@/: Supported actions of the destination, or 0 to indicate
    --    that a drop will not be accepted
    -> [Gdk.Flags.DragAction]
    -- ^ /@preferred@/: A unique action that\'s a member of /@actions@/ indicating the
    --    preferred action.
    -> m ()
dropStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDrop a) =>
a -> [DragAction] -> [DragAction] -> m ()
dropStatus a
self [DragAction]
actions [DragAction]
preferred = 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 Drop
self' <- a -> IO (Ptr Drop)
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
    let preferred' :: CUInt
preferred' = [DragAction] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DragAction]
preferred
    Ptr Drop -> CUInt -> CUInt -> IO ()
gdk_drop_status Ptr Drop
self' CUInt
actions' CUInt
preferred'
    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 DropStatusMethodInfo
instance (signature ~ ([Gdk.Flags.DragAction] -> [Gdk.Flags.DragAction] -> m ()), MonadIO m, IsDrop a) => O.OverloadedMethod DropStatusMethodInfo a signature where
    overloadedMethod = dropStatus

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


#endif