{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GdkClipboard@ object represents data shared between applications or
-- inside an application.
-- 
-- To get a @GdkClipboard@ object, use 'GI.Gdk.Objects.Display.displayGetClipboard' or
-- 'GI.Gdk.Objects.Display.displayGetPrimaryClipboard'. You can find out about the data
-- that is currently available in a clipboard using
-- 'GI.Gdk.Objects.Clipboard.clipboardGetFormats'.
-- 
-- To make text or image data available in a clipboard, use
-- t'GI.Gdk.Objects.Clipboard.Clipboard'.@/set_text/@() or t'GI.Gdk.Objects.Clipboard.Clipboard'.@/set_texture/@().
-- For other data, you can use 'GI.Gdk.Objects.Clipboard.clipboardSetContent', which
-- takes a t'GI.Gdk.Objects.ContentProvider.ContentProvider' object.
-- 
-- To read textual or image data from a clipboard, use
-- 'GI.Gdk.Objects.Clipboard.clipboardReadTextAsync' or
-- 'GI.Gdk.Objects.Clipboard.clipboardReadTextureAsync'. For other data, use
-- 'GI.Gdk.Objects.Clipboard.clipboardReadAsync', which provides a @GInputStream@ object.

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

module GI.Gdk.Objects.Clipboard
    ( 

-- * Exported types
    Clipboard(..)                           ,
    IsClipboard                             ,
    toClipboard                             ,


 -- * 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"), [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"), [isLocal]("GI.Gdk.Objects.Clipboard#g:method:isLocal"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [readAsync]("GI.Gdk.Objects.Clipboard#g:method:readAsync"), [readFinish]("GI.Gdk.Objects.Clipboard#g:method:readFinish"), [readTextAsync]("GI.Gdk.Objects.Clipboard#g:method:readTextAsync"), [readTextFinish]("GI.Gdk.Objects.Clipboard#g:method:readTextFinish"), [readTextureAsync]("GI.Gdk.Objects.Clipboard#g:method:readTextureAsync"), [readTextureFinish]("GI.Gdk.Objects.Clipboard#g:method:readTextureFinish"), [readValueAsync]("GI.Gdk.Objects.Clipboard#g:method:readValueAsync"), [readValueFinish]("GI.Gdk.Objects.Clipboard#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"), [set]("GI.Gdk.Objects.Clipboard#g:method:set"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [storeAsync]("GI.Gdk.Objects.Clipboard#g:method:storeAsync"), [storeFinish]("GI.Gdk.Objects.Clipboard#g:method:storeFinish"), [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
-- [getContent]("GI.Gdk.Objects.Clipboard#g:method:getContent"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDisplay]("GI.Gdk.Objects.Clipboard#g:method:getDisplay"), [getFormats]("GI.Gdk.Objects.Clipboard#g:method:getFormats"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setContent]("GI.Gdk.Objects.Clipboard#g:method:setContent"), [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)
    ResolveClipboardMethod                  ,
#endif

-- ** getContent #method:getContent#

#if defined(ENABLE_OVERLOADING)
    ClipboardGetContentMethodInfo           ,
#endif
    clipboardGetContent                     ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    ClipboardGetDisplayMethodInfo           ,
#endif
    clipboardGetDisplay                     ,


-- ** getFormats #method:getFormats#

#if defined(ENABLE_OVERLOADING)
    ClipboardGetFormatsMethodInfo           ,
#endif
    clipboardGetFormats                     ,


-- ** isLocal #method:isLocal#

#if defined(ENABLE_OVERLOADING)
    ClipboardIsLocalMethodInfo              ,
#endif
    clipboardIsLocal                        ,


-- ** readAsync #method:readAsync#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadAsyncMethodInfo            ,
#endif
    clipboardReadAsync                      ,


-- ** readFinish #method:readFinish#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadFinishMethodInfo           ,
#endif
    clipboardReadFinish                     ,


-- ** readTextAsync #method:readTextAsync#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadTextAsyncMethodInfo        ,
#endif
    clipboardReadTextAsync                  ,


-- ** readTextFinish #method:readTextFinish#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadTextFinishMethodInfo       ,
#endif
    clipboardReadTextFinish                 ,


-- ** readTextureAsync #method:readTextureAsync#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadTextureAsyncMethodInfo     ,
#endif
    clipboardReadTextureAsync               ,


-- ** readTextureFinish #method:readTextureFinish#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadTextureFinishMethodInfo    ,
#endif
    clipboardReadTextureFinish              ,


-- ** readValueAsync #method:readValueAsync#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadValueAsyncMethodInfo       ,
#endif
    clipboardReadValueAsync                 ,


-- ** readValueFinish #method:readValueFinish#

#if defined(ENABLE_OVERLOADING)
    ClipboardReadValueFinishMethodInfo      ,
#endif
    clipboardReadValueFinish                ,


-- ** set #method:set#

#if defined(ENABLE_OVERLOADING)
    ClipboardSetMethodInfo                  ,
#endif
    clipboardSet                            ,


-- ** setContent #method:setContent#

#if defined(ENABLE_OVERLOADING)
    ClipboardSetContentMethodInfo           ,
#endif
    clipboardSetContent                     ,


-- ** storeAsync #method:storeAsync#

#if defined(ENABLE_OVERLOADING)
    ClipboardStoreAsyncMethodInfo           ,
#endif
    clipboardStoreAsync                     ,


-- ** storeFinish #method:storeFinish#

#if defined(ENABLE_OVERLOADING)
    ClipboardStoreFinishMethodInfo          ,
#endif
    clipboardStoreFinish                    ,




 -- * Properties


-- ** content #attr:content#
-- | The @GdkContentProvider@ or 'P.Nothing' if the clipboard is empty or contents are
-- provided otherwise.

#if defined(ENABLE_OVERLOADING)
    ClipboardContentPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    clipboardContent                        ,
#endif
    getClipboardContent                     ,


-- ** display #attr:display#
-- | The @GdkDisplay@ that the clipboard belongs to.

#if defined(ENABLE_OVERLOADING)
    ClipboardDisplayPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    clipboardDisplay                        ,
#endif
    constructClipboardDisplay               ,
    getClipboardDisplay                     ,


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

#if defined(ENABLE_OVERLOADING)
    ClipboardFormatsPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    clipboardFormats                        ,
#endif
    getClipboardFormats                     ,


-- ** local #attr:local#
-- | 'P.True' if the contents of the clipboard are owned by this process.

#if defined(ENABLE_OVERLOADING)
    ClipboardLocalPropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    clipboardLocal                          ,
#endif
    getClipboardLocal                       ,




 -- * Signals


-- ** changed #signal:changed#

    ClipboardChangedCallback                ,
#if defined(ENABLE_OVERLOADING)
    ClipboardChangedSignalInfo              ,
#endif
    afterClipboardChanged                   ,
    onClipboardChanged                      ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Enums as Cairo.Enums
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Enums as Gdk.Enums
import {-# SOURCE #-} qualified GI.Gdk.Flags as Gdk.Flags
import {-# SOURCE #-} qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import {-# SOURCE #-} qualified GI.Gdk.Objects.AppLaunchContext as Gdk.AppLaunchContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.CairoContext as Gdk.CairoContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import {-# SOURCE #-} qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import {-# SOURCE #-} qualified GI.Gdk.Objects.Device as Gdk.Device
import {-# SOURCE #-} qualified GI.Gdk.Objects.DeviceTool as Gdk.DeviceTool
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.DrawContext as Gdk.DrawContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Event as Gdk.Event
import {-# SOURCE #-} qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import {-# SOURCE #-} qualified GI.Gdk.Objects.GLContext as Gdk.GLContext
import {-# SOURCE #-} qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import {-# SOURCE #-} qualified GI.Gdk.Objects.Seat as Gdk.Seat
import {-# SOURCE #-} qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import {-# SOURCE #-} qualified GI.Gdk.Objects.Surface as Gdk.Surface
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
import {-# SOURCE #-} qualified GI.Gdk.Objects.VulkanContext as Gdk.VulkanContext
import {-# SOURCE #-} qualified GI.Gdk.Structs.ContentFormats as Gdk.ContentFormats
import {-# SOURCE #-} qualified GI.Gdk.Structs.DmabufFormats as Gdk.DmabufFormats
import {-# SOURCE #-} qualified GI.Gdk.Structs.EventSequence as Gdk.EventSequence
import {-# SOURCE #-} qualified GI.Gdk.Structs.FrameTimings as Gdk.FrameTimings
import {-# SOURCE #-} qualified GI.Gdk.Structs.KeymapKey as Gdk.KeymapKey
import {-# SOURCE #-} qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import {-# SOURCE #-} qualified GI.Gdk.Structs.TimeCoord as Gdk.TimeCoord
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Interfaces.LoadableIcon as Gio.LoadableIcon
import qualified GI.Gio.Objects.AppLaunchContext as Gio.AppLaunchContext
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Pango.Enums as Pango.Enums

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gdk.Objects.ContentProvider as Gdk.ContentProvider
import {-# SOURCE #-} qualified GI.Gdk.Objects.Display as Gdk.Display
import {-# SOURCE #-} qualified GI.Gdk.Objects.Texture as Gdk.Texture
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

#endif

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

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

foreign import ccall "gdk_clipboard_get_type"
    c_gdk_clipboard_get_type :: IO B.Types.GType

instance B.Types.TypedObject Clipboard where
    glibType :: IO GType
glibType = IO GType
c_gdk_clipboard_get_type

instance B.Types.GObject Clipboard

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveClipboardMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveClipboardMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveClipboardMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveClipboardMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveClipboardMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveClipboardMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveClipboardMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveClipboardMethod "isLocal" o = ClipboardIsLocalMethodInfo
    ResolveClipboardMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveClipboardMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveClipboardMethod "readAsync" o = ClipboardReadAsyncMethodInfo
    ResolveClipboardMethod "readFinish" o = ClipboardReadFinishMethodInfo
    ResolveClipboardMethod "readTextAsync" o = ClipboardReadTextAsyncMethodInfo
    ResolveClipboardMethod "readTextFinish" o = ClipboardReadTextFinishMethodInfo
    ResolveClipboardMethod "readTextureAsync" o = ClipboardReadTextureAsyncMethodInfo
    ResolveClipboardMethod "readTextureFinish" o = ClipboardReadTextureFinishMethodInfo
    ResolveClipboardMethod "readValueAsync" o = ClipboardReadValueAsyncMethodInfo
    ResolveClipboardMethod "readValueFinish" o = ClipboardReadValueFinishMethodInfo
    ResolveClipboardMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveClipboardMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveClipboardMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveClipboardMethod "set" o = ClipboardSetMethodInfo
    ResolveClipboardMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveClipboardMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveClipboardMethod "storeAsync" o = ClipboardStoreAsyncMethodInfo
    ResolveClipboardMethod "storeFinish" o = ClipboardStoreFinishMethodInfo
    ResolveClipboardMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveClipboardMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveClipboardMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveClipboardMethod "getContent" o = ClipboardGetContentMethodInfo
    ResolveClipboardMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveClipboardMethod "getDisplay" o = ClipboardGetDisplayMethodInfo
    ResolveClipboardMethod "getFormats" o = ClipboardGetFormatsMethodInfo
    ResolveClipboardMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveClipboardMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveClipboardMethod "setContent" o = ClipboardSetContentMethodInfo
    ResolveClipboardMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveClipboardMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveClipboardMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveClipboardMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Clipboard::changed
-- | Emitted when the clipboard changes ownership.
type ClipboardChangedCallback =
    IO ()

type C_ClipboardChangedCallback =
    Ptr Clipboard ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_ClipboardChangedCallback :: 
    GObject a => (a -> ClipboardChangedCallback) ->
    C_ClipboardChangedCallback
wrap_ClipboardChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_ClipboardChangedCallback
wrap_ClipboardChangedCallback a -> IO ()
gi'cb Ptr Clipboard
gi'selfPtr Ptr ()
_ = do
    Ptr Clipboard -> (Clipboard -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Clipboard
gi'selfPtr ((Clipboard -> IO ()) -> IO ()) -> (Clipboard -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Clipboard
gi'self -> a -> IO ()
gi'cb (Clipboard -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Clipboard
gi'self) 


-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' clipboard #changed callback
-- @
-- 
-- 
onClipboardChanged :: (IsClipboard a, MonadIO m) => a -> ((?self :: a) => ClipboardChangedCallback) -> m SignalHandlerId
onClipboardChanged :: forall a (m :: * -> *).
(IsClipboard a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onClipboardChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ClipboardChangedCallback
wrapped' = (a -> IO ()) -> C_ClipboardChangedCallback
forall a. GObject a => (a -> IO ()) -> C_ClipboardChangedCallback
wrap_ClipboardChangedCallback a -> IO ()
wrapped
    wrapped'' <- C_ClipboardChangedCallback
-> IO (FunPtr C_ClipboardChangedCallback)
mk_ClipboardChangedCallback C_ClipboardChangedCallback
wrapped'
    connectSignalFunPtr obj "changed" wrapped'' SignalConnectBefore Nothing

-- | Connect a signal handler for the [changed](#signal:changed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' clipboard #changed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterClipboardChanged :: (IsClipboard a, MonadIO m) => a -> ((?self :: a) => ClipboardChangedCallback) -> m SignalHandlerId
afterClipboardChanged :: forall a (m :: * -> *).
(IsClipboard a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterClipboardChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_ClipboardChangedCallback
wrapped' = (a -> IO ()) -> C_ClipboardChangedCallback
forall a. GObject a => (a -> IO ()) -> C_ClipboardChangedCallback
wrap_ClipboardChangedCallback a -> IO ()
wrapped
    wrapped'' <- C_ClipboardChangedCallback
-> IO (FunPtr C_ClipboardChangedCallback)
mk_ClipboardChangedCallback C_ClipboardChangedCallback
wrapped'
    connectSignalFunPtr obj "changed" wrapped'' SignalConnectAfter Nothing


#if defined(ENABLE_OVERLOADING)
data ClipboardChangedSignalInfo
instance SignalInfo ClipboardChangedSignalInfo where
    type HaskellCallbackType ClipboardChangedSignalInfo = ClipboardChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ClipboardChangedCallback cb
        cb'' <- mk_ClipboardChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard::changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#g:signal:changed"})

#endif

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

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

#if defined(ENABLE_OVERLOADING)
data ClipboardContentPropertyInfo
instance AttrInfo ClipboardContentPropertyInfo where
    type AttrAllowedOps ClipboardContentPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClipboardContentPropertyInfo = IsClipboard
    type AttrSetTypeConstraint ClipboardContentPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClipboardContentPropertyInfo = (~) ()
    type AttrTransferType ClipboardContentPropertyInfo = ()
    type AttrGetType ClipboardContentPropertyInfo = (Maybe Gdk.ContentProvider.ContentProvider)
    type AttrLabel ClipboardContentPropertyInfo = "content"
    type AttrOrigin ClipboardContentPropertyInfo = Clipboard
    attrGet = getClipboardContent
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.content"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#g:attr:content"
        })
#endif

-- VVV Prop "display"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Display"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- 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' clipboard #display
-- @
getClipboardDisplay :: (MonadIO m, IsClipboard o) => o -> m Gdk.Display.Display
getClipboardDisplay :: forall (m :: * -> *) o.
(MonadIO m, IsClipboard o) =>
o -> m Display
getClipboardDisplay o
obj = IO Display -> m Display
forall a. IO a -> m a
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
"getClipboardDisplay" (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

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

#if defined(ENABLE_OVERLOADING)
data ClipboardDisplayPropertyInfo
instance AttrInfo ClipboardDisplayPropertyInfo where
    type AttrAllowedOps ClipboardDisplayPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClipboardDisplayPropertyInfo = IsClipboard
    type AttrSetTypeConstraint ClipboardDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferTypeConstraint ClipboardDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferType ClipboardDisplayPropertyInfo = Gdk.Display.Display
    type AttrGetType ClipboardDisplayPropertyInfo = Gdk.Display.Display
    type AttrLabel ClipboardDisplayPropertyInfo = "display"
    type AttrOrigin ClipboardDisplayPropertyInfo = Clipboard
    attrGet = getClipboardDisplay
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Display.Display v
    attrConstruct = constructClipboardDisplay
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.display"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#g:attr:display"
        })
#endif

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

#if defined(ENABLE_OVERLOADING)
data ClipboardFormatsPropertyInfo
instance AttrInfo ClipboardFormatsPropertyInfo where
    type AttrAllowedOps ClipboardFormatsPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ClipboardFormatsPropertyInfo = IsClipboard
    type AttrSetTypeConstraint ClipboardFormatsPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClipboardFormatsPropertyInfo = (~) ()
    type AttrTransferType ClipboardFormatsPropertyInfo = ()
    type AttrGetType ClipboardFormatsPropertyInfo = Gdk.ContentFormats.ContentFormats
    type AttrLabel ClipboardFormatsPropertyInfo = "formats"
    type AttrOrigin ClipboardFormatsPropertyInfo = Clipboard
    attrGet = getClipboardFormats
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.formats"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#g:attr:formats"
        })
#endif

-- VVV Prop "local"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data ClipboardLocalPropertyInfo
instance AttrInfo ClipboardLocalPropertyInfo where
    type AttrAllowedOps ClipboardLocalPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint ClipboardLocalPropertyInfo = IsClipboard
    type AttrSetTypeConstraint ClipboardLocalPropertyInfo = (~) ()
    type AttrTransferTypeConstraint ClipboardLocalPropertyInfo = (~) ()
    type AttrTransferType ClipboardLocalPropertyInfo = ()
    type AttrGetType ClipboardLocalPropertyInfo = Bool
    type AttrLabel ClipboardLocalPropertyInfo = "local"
    type AttrOrigin ClipboardLocalPropertyInfo = Clipboard
    attrGet = getClipboardLocal
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.local"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#g:attr:local"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Clipboard
type instance O.AttributeList Clipboard = ClipboardAttributeList
type ClipboardAttributeList = ('[ '("content", ClipboardContentPropertyInfo), '("display", ClipboardDisplayPropertyInfo), '("formats", ClipboardFormatsPropertyInfo), '("local", ClipboardLocalPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
clipboardContent :: AttrLabelProxy "content"
clipboardContent = AttrLabelProxy

clipboardDisplay :: AttrLabelProxy "display"
clipboardDisplay = AttrLabelProxy

clipboardFormats :: AttrLabelProxy "formats"
clipboardFormats = AttrLabelProxy

clipboardLocal :: AttrLabelProxy "local"
clipboardLocal = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Clipboard = ClipboardSignalList
type ClipboardSignalList = ('[ '("changed", ClipboardChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "gdk_clipboard_get_content" gdk_clipboard_get_content :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    IO (Ptr Gdk.ContentProvider.ContentProvider)

-- | Returns the @GdkContentProvider@ currently set on /@clipboard@/.
-- 
-- If the /@clipboard@/ is empty or its contents are not owned by the
-- current process, 'P.Nothing' will be returned.
clipboardGetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> m (Maybe Gdk.ContentProvider.ContentProvider)
    -- ^ __Returns:__ The content of a clipboard
    --   if the clipboard does not maintain any content
clipboardGetContent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> m (Maybe ContentProvider)
clipboardGetContent a
clipboard = IO (Maybe ContentProvider) -> m (Maybe ContentProvider)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentProvider) -> m (Maybe ContentProvider))
-> IO (Maybe ContentProvider) -> m (Maybe ContentProvider)
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result <- gdk_clipboard_get_content clipboard'
    maybeResult <- convertIfNonNull result $ \Ptr ContentProvider
result' -> do
        result'' <- ((ManagedPtr ContentProvider -> ContentProvider)
-> Ptr ContentProvider -> IO ContentProvider
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContentProvider -> ContentProvider
Gdk.ContentProvider.ContentProvider) Ptr ContentProvider
result'
        return result''
    touchManagedPtr clipboard
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data ClipboardGetContentMethodInfo
instance (signature ~ (m (Maybe Gdk.ContentProvider.ContentProvider)), MonadIO m, IsClipboard a) => O.OverloadedMethod ClipboardGetContentMethodInfo a signature where
    overloadedMethod = clipboardGetContent

instance O.OverloadedMethodInfo ClipboardGetContentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardGetContent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardGetContent"
        })


#endif

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

foreign import ccall "gdk_clipboard_get_display" gdk_clipboard_get_display :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the @GdkDisplay@ that the clipboard was created for.
clipboardGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> m Gdk.Display.Display
    -- ^ __Returns:__ a @GdkDisplay@
clipboardGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> m Display
clipboardGetDisplay a
clipboard = IO Display -> m Display
forall a. IO a -> m a
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
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result <- gdk_clipboard_get_display clipboard'
    checkUnexpectedReturnNULL "clipboardGetDisplay" result
    result' <- (newObject Gdk.Display.Display) result
    touchManagedPtr clipboard
    return result'

#if defined(ENABLE_OVERLOADING)
data ClipboardGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsClipboard a) => O.OverloadedMethod ClipboardGetDisplayMethodInfo a signature where
    overloadedMethod = clipboardGetDisplay

instance O.OverloadedMethodInfo ClipboardGetDisplayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardGetDisplay",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardGetDisplay"
        })


#endif

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

foreign import ccall "gdk_clipboard_get_formats" gdk_clipboard_get_formats :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    IO (Ptr Gdk.ContentFormats.ContentFormats)

-- | Gets the formats that the clipboard can provide its current contents in.
clipboardGetFormats ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> m Gdk.ContentFormats.ContentFormats
    -- ^ __Returns:__ The formats of the clipboard
clipboardGetFormats :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> m ContentFormats
clipboardGetFormats a
clipboard = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result <- gdk_clipboard_get_formats clipboard'
    checkUnexpectedReturnNULL "clipboardGetFormats" result
    result' <- (newBoxed Gdk.ContentFormats.ContentFormats) result
    touchManagedPtr clipboard
    return result'

#if defined(ENABLE_OVERLOADING)
data ClipboardGetFormatsMethodInfo
instance (signature ~ (m Gdk.ContentFormats.ContentFormats), MonadIO m, IsClipboard a) => O.OverloadedMethod ClipboardGetFormatsMethodInfo a signature where
    overloadedMethod = clipboardGetFormats

instance O.OverloadedMethodInfo ClipboardGetFormatsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardGetFormats",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardGetFormats"
        })


#endif

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

foreign import ccall "gdk_clipboard_is_local" gdk_clipboard_is_local :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    IO CInt

-- | Returns if the clipboard is local.
-- 
-- A clipboard is considered local if it was last claimed
-- by the running application.
-- 
-- Note that 'GI.Gdk.Objects.Clipboard.clipboardGetContent' may return 'P.Nothing'
-- even on a local clipboard. In this case the clipboard is empty.
clipboardIsLocal ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the clipboard is local
clipboardIsLocal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> m Bool
clipboardIsLocal a
clipboard = IO Bool -> m Bool
forall a. IO a -> m a
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
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result <- gdk_clipboard_is_local clipboard'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr clipboard
    return result'

#if defined(ENABLE_OVERLOADING)
data ClipboardIsLocalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsClipboard a) => O.OverloadedMethod ClipboardIsLocalMethodInfo a signature where
    overloadedMethod = clipboardIsLocal

instance O.OverloadedMethodInfo ClipboardIsLocalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardIsLocal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardIsLocal"
        })


#endif

-- method Clipboard::read_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_types"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a %NULL-terminated array of mime types to choose from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional `GCancellable` object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_read_async" gdk_clipboard_read_async :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    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 requests an input stream to read the /@clipboard@/\'s
-- contents from.
-- 
-- When the operation is finished /@callback@/ will be called. You must then
-- call 'GI.Gdk.Objects.Clipboard.clipboardReadFinish' to get the result of the operation.
-- 
-- The clipboard will choose the most suitable mime type from the given list
-- to fulfill the request, preferring the ones listed first.
clipboardReadAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> [T.Text]
    -- ^ /@mimeTypes@/: a 'P.Nothing'-terminated array of mime types to choose from
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
clipboardReadAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsCancellable b) =>
a -> [Text] -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clipboardReadAsync a
clipboard [Text]
mimeTypes Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    mimeTypes' <- packZeroTerminatedUTF8CArray mimeTypes
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gdk_clipboard_read_async clipboard' mimeTypes' ioPriority maybeCancellable maybeCallback userData
    touchManagedPtr clipboard
    whenJust cancellable touchManagedPtr
    mapZeroTerminatedCArray freeMem mimeTypes'
    freeMem mimeTypes'
    return ()

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

instance O.OverloadedMethodInfo ClipboardReadAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadAsync"
        })


#endif

-- method Clipboard::read_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store\n  the chosen mime type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_clipboard_read_finish" gdk_clipboard_read_finish :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    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 asynchronous clipboard read.
-- 
-- See 'GI.Gdk.Objects.Clipboard.clipboardReadAsync'.
clipboardReadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m ((Maybe Gio.InputStream.InputStream, T.Text))
    -- ^ __Returns:__ a @GInputStream@ /(Can throw 'Data.GI.Base.GError.GError')/
clipboardReadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsAsyncResult b) =>
a -> b -> m (Maybe InputStream, Text)
clipboardReadFinish a
clipboard b
result_ = IO (Maybe InputStream, Text) -> m (Maybe InputStream, Text)
forall a. IO a -> m a
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
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result_' <- unsafeManagedPtrCastPtr result_
    outMimeType <- callocMem :: IO (Ptr CString)
    onException (do
        result <- propagateGError $ gdk_clipboard_read_finish clipboard' result_' outMimeType
        maybeResult <- convertIfNonNull result $ \Ptr InputStream
result' -> do
            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'
            return result''
        outMimeType' <- peek outMimeType
        outMimeType'' <- cstringToText outMimeType'
        touchManagedPtr clipboard
        touchManagedPtr result_
        freeMem outMimeType
        return (maybeResult, outMimeType'')
     ) (do
        freeMem outMimeType
     )

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

instance O.OverloadedMethodInfo ClipboardReadFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadFinish"
        })


#endif

-- method Clipboard::read_text_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional `GCancellable` object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_read_text_async" gdk_clipboard_read_text_async :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    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 /@clipboard@/ contents converted to a string.
-- 
-- When the operation is finished /@callback@/ will be called. You must then
-- call 'GI.Gdk.Objects.Clipboard.clipboardReadTextFinish' to get the result.
-- 
-- This is a simple wrapper around 'GI.Gdk.Objects.Clipboard.clipboardReadValueAsync'.
-- Use that function or 'GI.Gdk.Objects.Clipboard.clipboardReadAsync' directly if you
-- need more control over the operation.
clipboardReadTextAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
clipboardReadTextAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clipboardReadTextAsync a
clipboard Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gdk_clipboard_read_text_async clipboard' maybeCancellable maybeCallback userData
    touchManagedPtr clipboard
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data ClipboardReadTextAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClipboardReadTextAsyncMethodInfo a signature where
    overloadedMethod = clipboardReadTextAsync

instance O.OverloadedMethodInfo ClipboardReadTextAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadTextAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadTextAsync"
        })


#endif

-- method Clipboard::read_text_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_clipboard_read_text_finish" gdk_clipboard_read_text_finish :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Finishes an asynchronous clipboard read.
-- 
-- See 'GI.Gdk.Objects.Clipboard.clipboardReadTextAsync'.
clipboardReadTextFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a new string /(Can throw 'Data.GI.Base.GError.GError')/
clipboardReadTextFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsAsyncResult b) =>
a -> b -> m (Maybe Text)
clipboardReadTextFinish a
clipboard b
result_ = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gdk_clipboard_read_text_finish clipboard' result_'
        maybeResult <- convertIfNonNull result $ \CString
result' -> do
            result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            freeMem result'
            return result''
        touchManagedPtr clipboard
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ClipboardReadTextFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadTextFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadTextFinish"
        })


#endif

-- method Clipboard::read_texture_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_read_texture_async" gdk_clipboard_read_texture_async :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    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 /@clipboard@/ contents converted to a @GdkPixbuf@.
-- 
-- When the operation is finished /@callback@/ will be called. You must then
-- call 'GI.Gdk.Objects.Clipboard.clipboardReadTextureFinish' to get the result.
-- 
-- This is a simple wrapper around 'GI.Gdk.Objects.Clipboard.clipboardReadValueAsync'.
-- Use that function or 'GI.Gdk.Objects.Clipboard.clipboardReadAsync' directly if you
-- need more control over the operation.
clipboardReadTextureAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object, 'P.Nothing' to ignore.
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
clipboardReadTextureAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clipboardReadTextureAsync a
clipboard Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gdk_clipboard_read_texture_async clipboard' maybeCancellable maybeCallback userData
    touchManagedPtr clipboard
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data ClipboardReadTextureAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ClipboardReadTextureAsyncMethodInfo a signature where
    overloadedMethod = clipboardReadTextureAsync

instance O.OverloadedMethodInfo ClipboardReadTextureAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadTextureAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadTextureAsync"
        })


#endif

-- method Clipboard::read_texture_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Texture" })
-- throws : True
-- Skip return : False

foreign import ccall "gdk_clipboard_read_texture_finish" gdk_clipboard_read_texture_finish :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gdk.Texture.Texture)

-- | Finishes an asynchronous clipboard read.
-- 
-- See 'GI.Gdk.Objects.Clipboard.clipboardReadTextureAsync'.
clipboardReadTextureFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Gdk.Texture.Texture)
    -- ^ __Returns:__ a new @GdkTexture@ /(Can throw 'Data.GI.Base.GError.GError')/
clipboardReadTextureFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsAsyncResult b) =>
a -> b -> m (Maybe Texture)
clipboardReadTextureFinish a
clipboard b
result_ = IO (Maybe Texture) -> m (Maybe Texture)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Texture) -> m (Maybe Texture))
-> IO (Maybe Texture) -> m (Maybe Texture)
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gdk_clipboard_read_texture_finish clipboard' result_'
        maybeResult <- convertIfNonNull result $ \Ptr Texture
result' -> do
            result'' <- ((ManagedPtr Texture -> Texture) -> Ptr Texture -> IO Texture
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Texture -> Texture
Gdk.Texture.Texture) Ptr Texture
result'
            return result''
        touchManagedPtr clipboard
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClipboardReadTextureFinishMethodInfo
instance (signature ~ (b -> m (Maybe Gdk.Texture.Texture)), MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClipboardReadTextureFinishMethodInfo a signature where
    overloadedMethod = clipboardReadTextureFinish

instance O.OverloadedMethodInfo ClipboardReadTextureFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadTextureFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadTextureFinish"
        })


#endif

-- method Clipboard::read_value_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional `GCancellable` object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_read_value_async" gdk_clipboard_read_value_async :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    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 /@clipboard@/ contents converted to the given
-- /@type@/.
-- 
-- When the operation is finished /@callback@/ will be called. You must then call
-- 'GI.Gdk.Objects.Clipboard.clipboardReadValueFinish' to get the resulting @GValue@.
-- 
-- For local clipboard contents that are available in the given @GType@,
-- the value will be copied directly. Otherwise, GDK will try to use
-- [func/@contentDeserializeAsync@/] to convert the clipboard\'s data.
clipboardReadValueAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> GType
    -- ^ /@type@/: a @GType@ to read
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
clipboardReadValueAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsCancellable b) =>
a -> GType -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clipboardReadValueAsync a
clipboard GType
type_ Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    let type_' = GType -> CGType
gtypeToCGType GType
type_
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gdk_clipboard_read_value_async clipboard' type_' ioPriority maybeCancellable maybeCallback userData
    touchManagedPtr clipboard
    whenJust cancellable touchManagedPtr
    return ()

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

instance O.OverloadedMethodInfo ClipboardReadValueAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadValueAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadValueAsync"
        })


#endif

-- method Clipboard::read_value_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : True
-- Skip return : False

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

-- | Finishes an asynchronous clipboard read.
-- 
-- See 'GI.Gdk.Objects.Clipboard.clipboardReadValueAsync'.
clipboardReadValueFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m GValue
    -- ^ __Returns:__ a @GValue@ containing the result. /(Can throw 'Data.GI.Base.GError.GError')/
clipboardReadValueFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsAsyncResult b) =>
a -> b -> m GValue
clipboardReadValueFinish a
clipboard b
result_ = IO GValue -> m GValue
forall a. IO a -> m a
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
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gdk_clipboard_read_value_finish clipboard' result_'
        checkUnexpectedReturnNULL "clipboardReadValueFinish" result
        result' <- B.GValue.newGValueFromPtr result
        touchManagedPtr clipboard
        touchManagedPtr result_
        return result'
     ) (do
        return ()
     )

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

instance O.OverloadedMethodInfo ClipboardReadValueFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardReadValueFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardReadValueFinish"
        })


#endif

-- method Clipboard::set_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provider"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentProvider" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the new contents of @clipboard\n  or %NULL to clear the clipboard"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_set_content" gdk_clipboard_set_content :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    Ptr Gdk.ContentProvider.ContentProvider -> -- provider : TInterface (Name {namespace = "Gdk", name = "ContentProvider"})
    IO CInt

-- | Sets a new content provider on /@clipboard@/.
-- 
-- The clipboard will claim the @GdkDisplay@\'s resources and advertise
-- these new contents to other applications.
-- 
-- In the rare case of a failure, this function will return 'P.False'. The
-- clipboard will then continue reporting its old contents and ignore
-- /@provider@/.
-- 
-- If the contents are read by either an external application or the
-- /@clipboard@/\'s read functions, /@clipboard@/ will select the best format to
-- transfer the contents and then request that format from /@provider@/.
clipboardSetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gdk.ContentProvider.IsContentProvider b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> Maybe (b)
    -- ^ /@provider@/: the new contents of /@clipboard@/
    --   or 'P.Nothing' to clear the clipboard
    -> m Bool
    -- ^ __Returns:__ 'P.True' if setting the clipboard succeeded
clipboardSetContent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsContentProvider b) =>
a -> Maybe b -> m Bool
clipboardSetContent a
clipboard Maybe b
provider = IO Bool -> m Bool
forall a. IO a -> m a
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
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    maybeProvider <- case provider of
        Maybe b
Nothing -> Ptr ContentProvider -> IO (Ptr ContentProvider)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ContentProvider
forall a. Ptr a
FP.nullPtr
        Just b
jProvider -> do
            jProvider' <- b -> IO (Ptr ContentProvider)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProvider
            return jProvider'
    result <- gdk_clipboard_set_content clipboard' maybeProvider
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr clipboard
    whenJust provider touchManagedPtr
    return result'

#if defined(ENABLE_OVERLOADING)
data ClipboardSetContentMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsClipboard a, Gdk.ContentProvider.IsContentProvider b) => O.OverloadedMethod ClipboardSetContentMethodInfo a signature where
    overloadedMethod = clipboardSetContent

instance O.OverloadedMethodInfo ClipboardSetContentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardSetContent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardSetContent"
        })


#endif

-- method Clipboard::set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GValue` to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_set_value" gdk_clipboard_set_value :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the /@clipboard@/ to contain the given /@value@/.
clipboardSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> GValue
    -- ^ /@value@/: a @GValue@ to set
    -> m ()
clipboardSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClipboard a) =>
a -> GValue -> m ()
clipboardSet a
clipboard GValue
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    value' <- unsafeManagedPtrGetPtr value
    gdk_clipboard_set_value clipboard' value'
    touchManagedPtr clipboard
    touchManagedPtr value
    return ()

#if defined(ENABLE_OVERLOADING)
data ClipboardSetMethodInfo
instance (signature ~ (GValue -> m ()), MonadIO m, IsClipboard a) => O.OverloadedMethod ClipboardSetMethodInfo a signature where
    overloadedMethod = clipboardSet

instance O.OverloadedMethodInfo ClipboardSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardSet"
        })


#endif

-- method Clipboard::store_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the I/O priority of the request"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional `GCancellable` object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_clipboard_store_async" gdk_clipboard_store_async :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    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 instructs the /@clipboard@/ to store its contents remotely.
-- 
-- If the clipboard is not local, this function does nothing but report success.
-- 
-- The /@callback@/ must call 'GI.Gdk.Objects.Clipboard.clipboardStoreFinish'.
-- 
-- The purpose of this call is to preserve clipboard contents beyond the
-- lifetime of an application, so this function is typically called on
-- exit. Depending on the platform, the functionality may not be available
-- unless a \"clipboard manager\" is running.
-- 
-- This function is called automatically when a
-- <http://developer.gnome.org/gdk/stable/../gtk4/class.Application.html GtkApplication>
-- is shut down, so you likely don\'t need to call it.
clipboardStoreAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> Int32
    -- ^ /@ioPriority@/: the I\/O priority of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional @GCancellable@ object
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: callback to call when the request is satisfied
    -> m ()
clipboardStoreAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
clipboardStoreAsync a
clipboard Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gdk_clipboard_store_async clipboard' ioPriority maybeCancellable maybeCallback userData
    touchManagedPtr clipboard
    whenJust cancellable touchManagedPtr
    return ()

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

instance O.OverloadedMethodInfo ClipboardStoreAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardStoreAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardStoreAsync"
        })


#endif

-- method Clipboard::store_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "clipboard"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Clipboard" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkClipboard`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "gdk_clipboard_store_finish" gdk_clipboard_store_finish :: 
    Ptr Clipboard ->                        -- clipboard : TInterface (Name {namespace = "Gdk", name = "Clipboard"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous clipboard store.
-- 
-- See 'GI.Gdk.Objects.Clipboard.clipboardStoreAsync'.
clipboardStoreFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@clipboard@/: a @GdkClipboard@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
clipboardStoreFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsClipboard a, IsAsyncResult b) =>
a -> b -> m ()
clipboardStoreFinish a
clipboard b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    clipboard' <- a -> IO (Ptr Clipboard)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
clipboard
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ gdk_clipboard_store_finish clipboard' result_'
        touchManagedPtr clipboard
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data ClipboardStoreFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsClipboard a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod ClipboardStoreFinishMethodInfo a signature where
    overloadedMethod = clipboardStoreFinish

instance O.OverloadedMethodInfo ClipboardStoreFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Objects.Clipboard.clipboardStoreFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Objects-Clipboard.html#v:clipboardStoreFinish"
        })


#endif