{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.GdkX11.Objects.X11DragContext
    ( 

-- * Exported types
    X11DragContext(..)                      ,
    IsX11DragContext                        ,
    toX11DragContext                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveX11DragContextMethod             ,
#endif




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.DragContext as Gdk.DragContext

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

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

foreign import ccall "gdk_x11_drag_context_get_type"
    c_gdk_x11_drag_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject X11DragContext where
    glibType :: IO GType
glibType = IO GType
c_gdk_x11_drag_context_get_type

instance B.Types.GObject X11DragContext

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

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

instance O.HasParentTypes X11DragContext
type instance O.ParentTypes X11DragContext = '[Gdk.DragContext.DragContext, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveX11DragContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveX11DragContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveX11DragContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveX11DragContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveX11DragContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveX11DragContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveX11DragContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveX11DragContextMethod "listTargets" o = Gdk.DragContext.DragContextListTargetsMethodInfo
    ResolveX11DragContextMethod "manageDnd" o = Gdk.DragContext.DragContextManageDndMethodInfo
    ResolveX11DragContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveX11DragContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveX11DragContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveX11DragContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveX11DragContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveX11DragContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveX11DragContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveX11DragContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveX11DragContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveX11DragContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveX11DragContextMethod "getActions" o = Gdk.DragContext.DragContextGetActionsMethodInfo
    ResolveX11DragContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveX11DragContextMethod "getDestWindow" o = Gdk.DragContext.DragContextGetDestWindowMethodInfo
    ResolveX11DragContextMethod "getDevice" o = Gdk.DragContext.DragContextGetDeviceMethodInfo
    ResolveX11DragContextMethod "getDragWindow" o = Gdk.DragContext.DragContextGetDragWindowMethodInfo
    ResolveX11DragContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveX11DragContextMethod "getProtocol" o = Gdk.DragContext.DragContextGetProtocolMethodInfo
    ResolveX11DragContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveX11DragContextMethod "getSelectedAction" o = Gdk.DragContext.DragContextGetSelectedActionMethodInfo
    ResolveX11DragContextMethod "getSourceWindow" o = Gdk.DragContext.DragContextGetSourceWindowMethodInfo
    ResolveX11DragContextMethod "getSuggestedAction" o = Gdk.DragContext.DragContextGetSuggestedActionMethodInfo
    ResolveX11DragContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveX11DragContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveX11DragContextMethod "setDevice" o = Gdk.DragContext.DragContextSetDeviceMethodInfo
    ResolveX11DragContextMethod "setHotspot" o = Gdk.DragContext.DragContextSetHotspotMethodInfo
    ResolveX11DragContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveX11DragContextMethod l o = O.MethodResolutionFailed l o

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList X11DragContext
type instance O.AttributeList X11DragContext = X11DragContextAttributeList
type X11DragContextAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList X11DragContext = X11DragContextSignalList
type X11DragContextSignalList = ('[ '("actionChanged", Gdk.DragContext.DragContextActionChangedSignalInfo), '("cancel", Gdk.DragContext.DragContextCancelSignalInfo), '("dndFinished", Gdk.DragContext.DragContextDndFinishedSignalInfo), '("dropPerformed", Gdk.DragContext.DragContextDropPerformedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif