{-# 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.Gdk.Objects.GrabBrokenEvent
    ( 

-- * Exported types
    GrabBrokenEvent(..)                     ,
    IsGrabBrokenEvent                       ,
    toGrabBrokenEvent                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveGrabBrokenEventMethod            ,
#endif


-- ** getGrabSurface #method:getGrabSurface#

#if defined(ENABLE_OVERLOADING)
    GrabBrokenEventGetGrabSurfaceMethodInfo ,
#endif
    grabBrokenEventGetGrabSurface           ,


-- ** getImplicit #method:getImplicit#

#if defined(ENABLE_OVERLOADING)
    GrabBrokenEventGetImplicitMethodInfo    ,
#endif
    grabBrokenEventGetImplicit              ,




    ) 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 {-# SOURCE #-} qualified GI.Gdk.Objects.Event as Gdk.Event
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface

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

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

foreign import ccall "gdk_grab_broken_event_get_type"
    c_gdk_grab_broken_event_get_type :: IO B.Types.GType

instance B.Types.TypedObject GrabBrokenEvent where
    glibType :: IO GType
glibType = IO GType
c_gdk_grab_broken_event_get_type

-- | Type class for types which can be safely cast to `GrabBrokenEvent`, for instance with `toGrabBrokenEvent`.
class (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf GrabBrokenEvent o) => IsGrabBrokenEvent o
instance (SP.BoxedPtr o, SP.TypedObject o, O.IsDescendantOf GrabBrokenEvent o) => IsGrabBrokenEvent o

instance O.HasParentTypes GrabBrokenEvent
type instance O.ParentTypes GrabBrokenEvent = '[Gdk.Event.Event]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveGrabBrokenEventMethod (t :: Symbol) (o :: *) :: * where
    ResolveGrabBrokenEventMethod "ref" o = Gdk.Event.EventRefMethodInfo
    ResolveGrabBrokenEventMethod "triggersContextMenu" o = Gdk.Event.EventTriggersContextMenuMethodInfo
    ResolveGrabBrokenEventMethod "unref" o = Gdk.Event.EventUnrefMethodInfo
    ResolveGrabBrokenEventMethod "getAxes" o = Gdk.Event.EventGetAxesMethodInfo
    ResolveGrabBrokenEventMethod "getAxis" o = Gdk.Event.EventGetAxisMethodInfo
    ResolveGrabBrokenEventMethod "getDevice" o = Gdk.Event.EventGetDeviceMethodInfo
    ResolveGrabBrokenEventMethod "getDeviceTool" o = Gdk.Event.EventGetDeviceToolMethodInfo
    ResolveGrabBrokenEventMethod "getDisplay" o = Gdk.Event.EventGetDisplayMethodInfo
    ResolveGrabBrokenEventMethod "getEventSequence" o = Gdk.Event.EventGetEventSequenceMethodInfo
    ResolveGrabBrokenEventMethod "getEventType" o = Gdk.Event.EventGetEventTypeMethodInfo
    ResolveGrabBrokenEventMethod "getGrabSurface" o = GrabBrokenEventGetGrabSurfaceMethodInfo
    ResolveGrabBrokenEventMethod "getImplicit" o = GrabBrokenEventGetImplicitMethodInfo
    ResolveGrabBrokenEventMethod "getModifierState" o = Gdk.Event.EventGetModifierStateMethodInfo
    ResolveGrabBrokenEventMethod "getPointerEmulated" o = Gdk.Event.EventGetPointerEmulatedMethodInfo
    ResolveGrabBrokenEventMethod "getPosition" o = Gdk.Event.EventGetPositionMethodInfo
    ResolveGrabBrokenEventMethod "getSourceDevice" o = Gdk.Event.EventGetSourceDeviceMethodInfo
    ResolveGrabBrokenEventMethod "getSurface" o = Gdk.Event.EventGetSurfaceMethodInfo
    ResolveGrabBrokenEventMethod "getTime" o = Gdk.Event.EventGetTimeMethodInfo
    ResolveGrabBrokenEventMethod l o = O.MethodResolutionFailed l o

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

#endif

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr GrabBrokenEvent where
    boxedPtrCopy :: GrabBrokenEvent -> IO GrabBrokenEvent
boxedPtrCopy = GrabBrokenEvent -> IO GrabBrokenEvent
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: GrabBrokenEvent -> IO ()
boxedPtrFree = \GrabBrokenEvent
_x -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- method GrabBrokenEvent::get_grab_surface
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "event"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "GrabBrokenEvent" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a grab broken event"
--                 , 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_grab_broken_event_get_grab_surface" gdk_grab_broken_event_get_grab_surface :: 
    Ptr GrabBrokenEvent ->                  -- event : TInterface (Name {namespace = "Gdk", name = "GrabBrokenEvent"})
    IO (Ptr Gdk.Surface.Surface)

-- | Extracts the grab surface from a grab broken event.
grabBrokenEventGetGrabSurface ::
    (B.CallStack.HasCallStack, MonadIO m, IsGrabBrokenEvent a) =>
    a
    -- ^ /@event@/: a grab broken event
    -> m Gdk.Surface.Surface
    -- ^ __Returns:__ the grab surface of /@event@/
grabBrokenEventGetGrabSurface :: a -> m Surface
grabBrokenEventGetGrabSurface a
event = 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 GrabBrokenEvent
event' <- a -> IO (Ptr GrabBrokenEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    Ptr Surface
result <- Ptr GrabBrokenEvent -> IO (Ptr Surface)
gdk_grab_broken_event_get_grab_surface Ptr GrabBrokenEvent
event'
    Text -> Ptr Surface -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"grabBrokenEventGetGrabSurface" 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
event
    Surface -> IO Surface
forall (m :: * -> *) a. Monad m => a -> m a
return Surface
result'

#if defined(ENABLE_OVERLOADING)
data GrabBrokenEventGetGrabSurfaceMethodInfo
instance (signature ~ (m Gdk.Surface.Surface), MonadIO m, IsGrabBrokenEvent a) => O.MethodInfo GrabBrokenEventGetGrabSurfaceMethodInfo a signature where
    overloadedMethod = grabBrokenEventGetGrabSurface

#endif

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

foreign import ccall "gdk_grab_broken_event_get_implicit" gdk_grab_broken_event_get_implicit :: 
    Ptr GrabBrokenEvent ->                  -- event : TInterface (Name {namespace = "Gdk", name = "GrabBrokenEvent"})
    IO CInt

-- | Checks whether the grab broken event is for an implicit grab.
grabBrokenEventGetImplicit ::
    (B.CallStack.HasCallStack, MonadIO m, IsGrabBrokenEvent a) =>
    a
    -- ^ /@event@/: a grab broken event
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the an implicit grab was broken
grabBrokenEventGetImplicit :: a -> m Bool
grabBrokenEventGetImplicit a
event = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr GrabBrokenEvent
event' <- a -> IO (Ptr GrabBrokenEvent)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
event
    CInt
result <- Ptr GrabBrokenEvent -> IO CInt
gdk_grab_broken_event_get_implicit Ptr GrabBrokenEvent
event'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
event
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data GrabBrokenEventGetImplicitMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsGrabBrokenEvent a) => O.MethodInfo GrabBrokenEventGetImplicitMethodInfo a signature where
    overloadedMethod = grabBrokenEventGetImplicit

#endif