{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Gtk.Structs.TargetList.TargetList'-struct is a reference counted list
-- of t'GI.Gtk.Structs.TargetPair.TargetPair' and should be treated as
-- opaque.

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

module GI.Gtk.Structs.TargetList
    ( 

-- * Exported types
    TargetList(..)                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [add]("GI.Gtk.Structs.TargetList#g:method:add"), [addImageTargets]("GI.Gtk.Structs.TargetList#g:method:addImageTargets"), [addRichTextTargets]("GI.Gtk.Structs.TargetList#g:method:addRichTextTargets"), [addTable]("GI.Gtk.Structs.TargetList#g:method:addTable"), [addTextTargets]("GI.Gtk.Structs.TargetList#g:method:addTextTargets"), [addUriTargets]("GI.Gtk.Structs.TargetList#g:method:addUriTargets"), [find]("GI.Gtk.Structs.TargetList#g:method:find"), [ref]("GI.Gtk.Structs.TargetList#g:method:ref"), [remove]("GI.Gtk.Structs.TargetList#g:method:remove"), [unref]("GI.Gtk.Structs.TargetList#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveTargetListMethod                 ,
#endif

-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    TargetListAddMethodInfo                 ,
#endif
    targetListAdd                           ,


-- ** addImageTargets #method:addImageTargets#

#if defined(ENABLE_OVERLOADING)
    TargetListAddImageTargetsMethodInfo     ,
#endif
    targetListAddImageTargets               ,


-- ** addRichTextTargets #method:addRichTextTargets#

#if defined(ENABLE_OVERLOADING)
    TargetListAddRichTextTargetsMethodInfo  ,
#endif
    targetListAddRichTextTargets            ,


-- ** addTable #method:addTable#

#if defined(ENABLE_OVERLOADING)
    TargetListAddTableMethodInfo            ,
#endif
    targetListAddTable                      ,


-- ** addTextTargets #method:addTextTargets#

#if defined(ENABLE_OVERLOADING)
    TargetListAddTextTargetsMethodInfo      ,
#endif
    targetListAddTextTargets                ,


-- ** addUriTargets #method:addUriTargets#

#if defined(ENABLE_OVERLOADING)
    TargetListAddUriTargetsMethodInfo       ,
#endif
    targetListAddUriTargets                 ,


-- ** find #method:find#

#if defined(ENABLE_OVERLOADING)
    TargetListFindMethodInfo                ,
#endif
    targetListFind                          ,


-- ** new #method:new#

    targetListNew                           ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    TargetListRefMethodInfo                 ,
#endif
    targetListRef                           ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    TargetListRemoveMethodInfo              ,
#endif
    targetListRemove                        ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TargetListUnrefMethodInfo               ,
#endif
    targetListUnref                         ,




    ) 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.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.Atk.Objects.Object as Atk.Object
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.Cairo.Structs.Region as Cairo.Region
import qualified GI.Cairo.Structs.Surface as Cairo.Surface
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.MarkupParser as GLib.MarkupParser
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Enums as Gdk.Enums
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.DragContext as Gdk.DragContext
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Screen as Gdk.Screen
import qualified GI.Gdk.Objects.Visual as Gdk.Visual
import qualified GI.Gdk.Objects.Window as Gdk.Window
import qualified GI.Gdk.Structs.Atom as Gdk.Atom
import qualified GI.Gdk.Structs.Color as Gdk.Color
import qualified GI.Gdk.Structs.EventAny as Gdk.EventAny
import qualified GI.Gdk.Structs.EventButton as Gdk.EventButton
import qualified GI.Gdk.Structs.EventConfigure as Gdk.EventConfigure
import qualified GI.Gdk.Structs.EventCrossing as Gdk.EventCrossing
import qualified GI.Gdk.Structs.EventExpose as Gdk.EventExpose
import qualified GI.Gdk.Structs.EventFocus as Gdk.EventFocus
import qualified GI.Gdk.Structs.EventGrabBroken as Gdk.EventGrabBroken
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
import qualified GI.Gdk.Structs.EventMotion as Gdk.EventMotion
import qualified GI.Gdk.Structs.EventOwnerChange as Gdk.EventOwnerChange
import qualified GI.Gdk.Structs.EventProperty as Gdk.EventProperty
import qualified GI.Gdk.Structs.EventProximity as Gdk.EventProximity
import qualified GI.Gdk.Structs.EventScroll as Gdk.EventScroll
import qualified GI.Gdk.Structs.EventSelection as Gdk.EventSelection
import qualified GI.Gdk.Structs.EventVisibility as Gdk.EventVisibility
import qualified GI.Gdk.Structs.EventWindowState as Gdk.EventWindowState
import qualified GI.Gdk.Structs.Geometry as Gdk.Geometry
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gdk.Unions.Event as Gdk.Event
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.ActionMap as Gio.ActionMap
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Objects.Application as Gio.Application
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.AccelGroup as Gtk.AccelGroup
import {-# SOURCE #-} qualified GI.Gtk.Objects.Adjustment as Gtk.Adjustment
import {-# SOURCE #-} qualified GI.Gtk.Objects.Application as Gtk.Application
import {-# SOURCE #-} qualified GI.Gtk.Objects.Bin as Gtk.Bin
import {-# SOURCE #-} qualified GI.Gtk.Objects.Builder as Gtk.Builder
import {-# SOURCE #-} qualified GI.Gtk.Objects.Clipboard as Gtk.Clipboard
import {-# SOURCE #-} qualified GI.Gtk.Objects.Container as Gtk.Container
import {-# SOURCE #-} qualified GI.Gtk.Objects.IconFactory as Gtk.IconFactory
import {-# SOURCE #-} qualified GI.Gtk.Objects.RcStyle as Gtk.RcStyle
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Style as Gtk.Style
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleProperties as Gtk.StyleProperties
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextChildAnchor as Gtk.TextChildAnchor
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextMark as Gtk.TextMark
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextTag as Gtk.TextTag
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextTagTable as Gtk.TextTagTable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window
import {-# SOURCE #-} qualified GI.Gtk.Objects.WindowGroup as Gtk.WindowGroup
import {-# SOURCE #-} qualified GI.Gtk.Structs.AccelGroupEntry as Gtk.AccelGroupEntry
import {-# SOURCE #-} qualified GI.Gtk.Structs.AccelKey as Gtk.AccelKey
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.CssSection as Gtk.CssSection
import {-# SOURCE #-} qualified GI.Gtk.Structs.IconSet as Gtk.IconSet
import {-# SOURCE #-} qualified GI.Gtk.Structs.IconSource as Gtk.IconSource
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import {-# SOURCE #-} qualified GI.Gtk.Structs.SelectionData as Gtk.SelectionData
import {-# SOURCE #-} qualified GI.Gtk.Structs.SettingsValue as Gtk.SettingsValue
import {-# SOURCE #-} qualified GI.Gtk.Structs.SymbolicColor as Gtk.SymbolicColor
import {-# SOURCE #-} qualified GI.Gtk.Structs.TargetEntry as Gtk.TargetEntry
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextAppearance as Gtk.TextAppearance
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextAttributes as Gtk.TextAttributes
import {-# SOURCE #-} qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.Gtk.Structs.WidgetPath as Gtk.WidgetPath
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout
import qualified GI.Pango.Structs.FontDescription as Pango.FontDescription
import qualified GI.Pango.Structs.Language as Pango.Language
import qualified GI.Pango.Structs.TabArray as Pango.TabArray

#else
import qualified GI.Gdk.Structs.Atom as Gdk.Atom
import {-# SOURCE #-} qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import {-# SOURCE #-} qualified GI.Gtk.Structs.TargetEntry as Gtk.TargetEntry

#endif

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

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

foreign import ccall "gtk_target_list_get_type" c_gtk_target_list_get_type :: 
    IO GType

type instance O.ParentTypes TargetList = '[]
instance O.HasParentTypes TargetList

instance B.Types.TypedObject TargetList where
    glibType :: IO GType
glibType = IO GType
c_gtk_target_list_get_type

instance B.Types.GBoxed TargetList

-- | Convert 'TargetList' 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 TargetList) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_target_list_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TargetList -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TargetList
P.Nothing = Ptr GValue -> Ptr TargetList -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr TargetList
forall a. Ptr a
FP.nullPtr :: FP.Ptr TargetList)
    gvalueSet_ Ptr GValue
gv (P.Just TargetList
obj) = TargetList -> (Ptr TargetList -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TargetList
obj (Ptr GValue -> Ptr TargetList -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TargetList)
gvalueGet_ Ptr GValue
gv = do
        Ptr TargetList
ptr <- Ptr GValue -> IO (Ptr TargetList)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr TargetList)
        if Ptr TargetList
ptr Ptr TargetList -> Ptr TargetList -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TargetList
forall a. Ptr a
FP.nullPtr
        then TargetList -> Maybe TargetList
forall a. a -> Maybe a
P.Just (TargetList -> Maybe TargetList)
-> IO TargetList -> IO (Maybe TargetList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr TargetList -> TargetList)
-> Ptr TargetList -> IO TargetList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr TargetList -> TargetList
TargetList Ptr TargetList
ptr
        else Maybe TargetList -> IO (Maybe TargetList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TargetList
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TargetList
type instance O.AttributeList TargetList = TargetListAttributeList
type TargetListAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method TargetList::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "targets"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "Gtk" , name = "TargetEntry" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to an array\n  of #GtkTargetEntry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ntargets"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entries in @targets."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "ntargets"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of entries in @targets."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "TargetList" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_target_list_new" gtk_target_list_new :: 
    Ptr Gtk.TargetEntry.TargetEntry ->      -- targets : TCArray False (-1) 1 (TInterface (Name {namespace = "Gtk", name = "TargetEntry"}))
    Word32 ->                               -- ntargets : TBasicType TUInt
    IO (Ptr TargetList)

-- | Creates a new t'GI.Gtk.Structs.TargetList.TargetList' from an array of t'GI.Gtk.Structs.TargetEntry.TargetEntry'.
targetListNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([Gtk.TargetEntry.TargetEntry])
    -- ^ /@targets@/: Pointer to an array
    --   of t'GI.Gtk.Structs.TargetEntry.TargetEntry'
    -> m TargetList
    -- ^ __Returns:__ the new t'GI.Gtk.Structs.TargetList.TargetList'.
targetListNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [TargetEntry] -> m TargetList
targetListNew Maybe [TargetEntry]
targets = IO TargetList -> m TargetList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TargetList -> m TargetList) -> IO TargetList -> m TargetList
forall a b. (a -> b) -> a -> b
$ do
    let ntargets :: Word32
ntargets = case Maybe [TargetEntry]
targets of
            Maybe [TargetEntry]
Nothing -> Word32
0
            Just [TargetEntry]
jTargets -> Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [TargetEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [TargetEntry]
jTargets
    Ptr TargetEntry
maybeTargets <- case Maybe [TargetEntry]
targets of
        Maybe [TargetEntry]
Nothing -> Ptr TargetEntry -> IO (Ptr TargetEntry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TargetEntry
forall a. Ptr a
FP.nullPtr
        Just [TargetEntry]
jTargets -> do
            [Ptr TargetEntry]
jTargets' <- (TargetEntry -> IO (Ptr TargetEntry))
-> [TargetEntry] -> IO [Ptr TargetEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TargetEntry -> IO (Ptr TargetEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [TargetEntry]
jTargets
            Ptr TargetEntry
jTargets'' <- Int -> [Ptr TargetEntry] -> IO (Ptr TargetEntry)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr TargetEntry]
jTargets'
            Ptr TargetEntry -> IO (Ptr TargetEntry)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr TargetEntry
jTargets''
    Ptr TargetList
result <- Ptr TargetEntry -> Word32 -> IO (Ptr TargetList)
gtk_target_list_new Ptr TargetEntry
maybeTargets Word32
ntargets
    Text -> Ptr TargetList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"targetListNew" Ptr TargetList
result
    TargetList
result' <- ((ManagedPtr TargetList -> TargetList)
-> Ptr TargetList -> IO TargetList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TargetList -> TargetList
TargetList) Ptr TargetList
result
    Maybe [TargetEntry] -> ([TargetEntry] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [TargetEntry]
targets ((TargetEntry -> IO ()) -> [TargetEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TargetEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    Ptr TargetEntry -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TargetEntry
maybeTargets
    TargetList -> IO TargetList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetList
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TargetList::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interned atom representing the target"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flags for this target"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an ID that will be passed back to the application"
--                 , 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 "gtk_target_list_add" gtk_target_list_add :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Ptr Gdk.Atom.Atom ->                    -- target : TInterface (Name {namespace = "Gdk", name = "Atom"})
    Word32 ->                               -- flags : TBasicType TUInt
    Word32 ->                               -- info : TBasicType TUInt
    IO ()

-- | Appends another target to a t'GI.Gtk.Structs.TargetList.TargetList'.
targetListAdd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Gdk.Atom.Atom
    -- ^ /@target@/: the interned atom representing the target
    -> Word32
    -- ^ /@flags@/: the flags for this target
    -> Word32
    -- ^ /@info@/: an ID that will be passed back to the application
    -> m ()
targetListAdd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> Atom -> Word32 -> Word32 -> m ()
targetListAdd TargetList
list Atom
target Word32
flags Word32
info = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr Atom
target' <- Atom -> IO (Ptr Atom)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Atom
target
    Ptr TargetList -> Ptr Atom -> Word32 -> Word32 -> IO ()
gtk_target_list_add Ptr TargetList
list' Ptr Atom
target' Word32
flags Word32
info
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    Atom -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Atom
target
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListAddMethodInfo
instance (signature ~ (Gdk.Atom.Atom -> Word32 -> Word32 -> m ()), MonadIO m) => O.OverloadedMethod TargetListAddMethodInfo TargetList signature where
    overloadedMethod = targetListAdd

instance O.OverloadedMethodInfo TargetListAddMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListAdd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListAdd"
        })


#endif

-- method TargetList::add_image_targets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an ID that will be passed back to the application"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "writable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "whether to add only targets for which GTK+ knows\n  how to convert a pixbuf into the format"
--                 , 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 "gtk_target_list_add_image_targets" gtk_target_list_add_image_targets :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Word32 ->                               -- info : TBasicType TUInt
    CInt ->                                 -- writable : TBasicType TBoolean
    IO ()

-- | Appends the image targets supported by t'GI.Gtk.Structs.SelectionData.SelectionData' to
-- the target list. All targets are added with the same /@info@/.
-- 
-- /Since: 2.6/
targetListAddImageTargets ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Word32
    -- ^ /@info@/: an ID that will be passed back to the application
    -> Bool
    -- ^ /@writable@/: whether to add only targets for which GTK+ knows
    --   how to convert a pixbuf into the format
    -> m ()
targetListAddImageTargets :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> Word32 -> Bool -> m ()
targetListAddImageTargets TargetList
list Word32
info Bool
writable = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    let writable' :: CInt
writable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
writable
    Ptr TargetList -> Word32 -> CInt -> IO ()
gtk_target_list_add_image_targets Ptr TargetList
list' Word32
info CInt
writable'
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListAddImageTargetsMethodInfo
instance (signature ~ (Word32 -> Bool -> m ()), MonadIO m) => O.OverloadedMethod TargetListAddImageTargetsMethodInfo TargetList signature where
    overloadedMethod = targetListAddImageTargets

instance O.OverloadedMethodInfo TargetListAddImageTargetsMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListAddImageTargets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListAddImageTargets"
        })


#endif

-- method TargetList::add_rich_text_targets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an ID that will be passed back to the application"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deserializable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if %TRUE, then deserializable rich text formats\n                 will be added, serializable formats otherwise."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextBuffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextBuffer." , 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 "gtk_target_list_add_rich_text_targets" gtk_target_list_add_rich_text_targets :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Word32 ->                               -- info : TBasicType TUInt
    CInt ->                                 -- deserializable : TBasicType TBoolean
    Ptr Gtk.TextBuffer.TextBuffer ->        -- buffer : TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
    IO ()

-- | Appends the rich text targets registered with
-- 'GI.Gtk.Objects.TextBuffer.textBufferRegisterSerializeFormat' or
-- 'GI.Gtk.Objects.TextBuffer.textBufferRegisterDeserializeFormat' to the target list. All
-- targets are added with the same /@info@/.
-- 
-- /Since: 2.10/
targetListAddRichTextTargets ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.TextBuffer.IsTextBuffer a) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Word32
    -- ^ /@info@/: an ID that will be passed back to the application
    -> Bool
    -- ^ /@deserializable@/: if 'P.True', then deserializable rich text formats
    --                  will be added, serializable formats otherwise.
    -> a
    -- ^ /@buffer@/: a t'GI.Gtk.Objects.TextBuffer.TextBuffer'.
    -> m ()
targetListAddRichTextTargets :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTextBuffer a) =>
TargetList -> Word32 -> Bool -> a -> m ()
targetListAddRichTextTargets TargetList
list Word32
info Bool
deserializable a
buffer = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    let deserializable' :: CInt
deserializable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
deserializable
    Ptr TextBuffer
buffer' <- a -> IO (Ptr TextBuffer)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
buffer
    Ptr TargetList -> Word32 -> CInt -> Ptr TextBuffer -> IO ()
gtk_target_list_add_rich_text_targets Ptr TargetList
list' Word32
info CInt
deserializable' Ptr TextBuffer
buffer'
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListAddRichTextTargetsMethodInfo
instance (signature ~ (Word32 -> Bool -> a -> m ()), MonadIO m, Gtk.TextBuffer.IsTextBuffer a) => O.OverloadedMethod TargetListAddRichTextTargetsMethodInfo TargetList signature where
    overloadedMethod = targetListAddRichTextTargets

instance O.OverloadedMethodInfo TargetListAddRichTextTargetsMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListAddRichTextTargets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListAddRichTextTargets"
        })


#endif

-- method TargetList::add_table
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "targets"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "Gtk" , name = "TargetEntry" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the table of #GtkTargetEntry"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ntargets"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of targets in the table"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "ntargets"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of targets in the table"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_target_list_add_table" gtk_target_list_add_table :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Ptr Gtk.TargetEntry.TargetEntry ->      -- targets : TCArray False (-1) 2 (TInterface (Name {namespace = "Gtk", name = "TargetEntry"}))
    Word32 ->                               -- ntargets : TBasicType TUInt
    IO ()

-- | Prepends a table of t'GI.Gtk.Structs.TargetEntry.TargetEntry' to a target list.
targetListAddTable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> [Gtk.TargetEntry.TargetEntry]
    -- ^ /@targets@/: the table of t'GI.Gtk.Structs.TargetEntry.TargetEntry'
    -> m ()
targetListAddTable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> [TargetEntry] -> m ()
targetListAddTable TargetList
list [TargetEntry]
targets = 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
    let ntargets :: Word32
ntargets = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [TargetEntry] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [TargetEntry]
targets
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    [Ptr TargetEntry]
targets' <- (TargetEntry -> IO (Ptr TargetEntry))
-> [TargetEntry] -> IO [Ptr TargetEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TargetEntry -> IO (Ptr TargetEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [TargetEntry]
targets
    Ptr TargetEntry
targets'' <- Int -> [Ptr TargetEntry] -> IO (Ptr TargetEntry)
forall a. Int -> [Ptr a] -> IO (Ptr a)
packBlockArray Int
16 [Ptr TargetEntry]
targets'
    Ptr TargetList -> Ptr TargetEntry -> Word32 -> IO ()
gtk_target_list_add_table Ptr TargetList
list' Ptr TargetEntry
targets'' Word32
ntargets
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    (TargetEntry -> IO ()) -> [TargetEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TargetEntry -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [TargetEntry]
targets
    Ptr TargetEntry -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr TargetEntry
targets''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListAddTableMethodInfo
instance (signature ~ ([Gtk.TargetEntry.TargetEntry] -> m ()), MonadIO m) => O.OverloadedMethod TargetListAddTableMethodInfo TargetList signature where
    overloadedMethod = targetListAddTable

instance O.OverloadedMethodInfo TargetListAddTableMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListAddTable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListAddTable"
        })


#endif

-- method TargetList::add_text_targets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an ID that will be passed back to the application"
--                 , 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 "gtk_target_list_add_text_targets" gtk_target_list_add_text_targets :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Word32 ->                               -- info : TBasicType TUInt
    IO ()

-- | Appends the text targets supported by t'GI.Gtk.Structs.SelectionData.SelectionData' to
-- the target list. All targets are added with the same /@info@/.
-- 
-- /Since: 2.6/
targetListAddTextTargets ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Word32
    -- ^ /@info@/: an ID that will be passed back to the application
    -> m ()
targetListAddTextTargets :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> Word32 -> m ()
targetListAddTextTargets TargetList
list Word32
info = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr TargetList -> Word32 -> IO ()
gtk_target_list_add_text_targets Ptr TargetList
list' Word32
info
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListAddTextTargetsMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod TargetListAddTextTargetsMethodInfo TargetList signature where
    overloadedMethod = targetListAddTextTargets

instance O.OverloadedMethodInfo TargetListAddTextTargetsMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListAddTextTargets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListAddTextTargets"
        })


#endif

-- method TargetList::add_uri_targets
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an ID that will be passed back to the application"
--                 , 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 "gtk_target_list_add_uri_targets" gtk_target_list_add_uri_targets :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Word32 ->                               -- info : TBasicType TUInt
    IO ()

-- | Appends the URI targets supported by t'GI.Gtk.Structs.SelectionData.SelectionData' to
-- the target list. All targets are added with the same /@info@/.
-- 
-- Since 3.24.37, this includes the application\/vnd.portal.files
-- target when possible, to allow sending files between sandboxed
-- apps via the FileTransfer portal.
-- 
-- /Since: 2.6/
targetListAddUriTargets ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Word32
    -- ^ /@info@/: an ID that will be passed back to the application
    -> m ()
targetListAddUriTargets :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> Word32 -> m ()
targetListAddUriTargets TargetList
list Word32
info = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr TargetList -> Word32 -> IO ()
gtk_target_list_add_uri_targets Ptr TargetList
list' Word32
info
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListAddUriTargetsMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod TargetListAddUriTargetsMethodInfo TargetList signature where
    overloadedMethod = targetListAddUriTargets

instance O.OverloadedMethodInfo TargetListAddUriTargetsMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListAddUriTargets",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListAddUriTargets"
        })


#endif

-- method TargetList::find
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "an interned atom representing the target to search for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to the location to store\n       application info for target, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_target_list_find" gtk_target_list_find :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Ptr Gdk.Atom.Atom ->                    -- target : TInterface (Name {namespace = "Gdk", name = "Atom"})
    Ptr Word32 ->                           -- info : TBasicType TUInt
    IO CInt

-- | Looks up a given target in a t'GI.Gtk.Structs.TargetList.TargetList'.
targetListFind ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Gdk.Atom.Atom
    -- ^ /@target@/: an interned atom representing the target to search for
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' if the target was found, otherwise 'P.False'
targetListFind :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> Atom -> m (Bool, Word32)
targetListFind TargetList
list Atom
target = IO (Bool, Word32) -> m (Bool, Word32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr Atom
target' <- Atom -> IO (Ptr Atom)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Atom
target
    Ptr Word32
info <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr TargetList -> Ptr Atom -> Ptr Word32 -> IO CInt
gtk_target_list_find Ptr TargetList
list' Ptr Atom
target' Ptr Word32
info
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Word32
info' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
info
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    Atom -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Atom
target
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
info
    (Bool, Word32) -> IO (Bool, Word32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
info')

#if defined(ENABLE_OVERLOADING)
data TargetListFindMethodInfo
instance (signature ~ (Gdk.Atom.Atom -> m ((Bool, Word32))), MonadIO m) => O.OverloadedMethod TargetListFindMethodInfo TargetList signature where
    overloadedMethod = targetListFind

instance O.OverloadedMethodInfo TargetListFindMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListFind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListFind"
        })


#endif

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

foreign import ccall "gtk_target_list_ref" gtk_target_list_ref :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    IO (Ptr TargetList)

-- | Increases the reference count of a t'GI.Gtk.Structs.TargetList.TargetList' by one.
targetListRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> m TargetList
    -- ^ __Returns:__ the passed in t'GI.Gtk.Structs.TargetList.TargetList'.
targetListRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> m TargetList
targetListRef TargetList
list = IO TargetList -> m TargetList
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TargetList -> m TargetList) -> IO TargetList -> m TargetList
forall a b. (a -> b) -> a -> b
$ do
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr TargetList
result <- Ptr TargetList -> IO (Ptr TargetList)
gtk_target_list_ref Ptr TargetList
list'
    Text -> Ptr TargetList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"targetListRef" Ptr TargetList
result
    TargetList
result' <- ((ManagedPtr TargetList -> TargetList)
-> Ptr TargetList -> IO TargetList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TargetList -> TargetList
TargetList) Ptr TargetList
result
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    TargetList -> IO TargetList
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TargetList
result'

#if defined(ENABLE_OVERLOADING)
data TargetListRefMethodInfo
instance (signature ~ (m TargetList), MonadIO m) => O.OverloadedMethod TargetListRefMethodInfo TargetList signature where
    overloadedMethod = targetListRef

instance O.OverloadedMethodInfo TargetListRefMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListRef"
        })


#endif

-- method TargetList::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TInterface Name { namespace = "Gdk" , name = "Atom" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the interned atom representing the target"
--                 , 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 "gtk_target_list_remove" gtk_target_list_remove :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    Ptr Gdk.Atom.Atom ->                    -- target : TInterface (Name {namespace = "Gdk", name = "Atom"})
    IO ()

-- | Removes a target from a target list.
targetListRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> Gdk.Atom.Atom
    -- ^ /@target@/: the interned atom representing the target
    -> m ()
targetListRemove :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> Atom -> m ()
targetListRemove TargetList
list Atom
target = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr Atom
target' <- Atom -> IO (Ptr Atom)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Atom
target
    Ptr TargetList -> Ptr Atom -> IO ()
gtk_target_list_remove Ptr TargetList
list' Ptr Atom
target'
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    Atom -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Atom
target
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListRemoveMethodInfo
instance (signature ~ (Gdk.Atom.Atom -> m ()), MonadIO m) => O.OverloadedMethod TargetListRemoveMethodInfo TargetList signature where
    overloadedMethod = targetListRemove

instance O.OverloadedMethodInfo TargetListRemoveMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListRemove"
        })


#endif

-- method TargetList::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "list"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TargetList" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTargetList" , 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 "gtk_target_list_unref" gtk_target_list_unref :: 
    Ptr TargetList ->                       -- list : TInterface (Name {namespace = "Gtk", name = "TargetList"})
    IO ()

-- | Decreases the reference count of a t'GI.Gtk.Structs.TargetList.TargetList' by one.
-- If the resulting reference count is zero, frees the list.
targetListUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TargetList
    -- ^ /@list@/: a t'GI.Gtk.Structs.TargetList.TargetList'
    -> m ()
targetListUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TargetList -> m ()
targetListUnref TargetList
list = 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
    Ptr TargetList
list' <- TargetList -> IO (Ptr TargetList)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TargetList
list
    Ptr TargetList -> IO ()
gtk_target_list_unref Ptr TargetList
list'
    TargetList -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TargetList
list
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TargetListUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TargetListUnrefMethodInfo TargetList signature where
    overloadedMethod = targetListUnref

instance O.OverloadedMethodInfo TargetListUnrefMethodInfo TargetList where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.TargetList.targetListUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-3.0.43/docs/GI-Gtk-Structs-TargetList.html#v:targetListUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTargetListMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTargetListMethod "add" o = TargetListAddMethodInfo
    ResolveTargetListMethod "addImageTargets" o = TargetListAddImageTargetsMethodInfo
    ResolveTargetListMethod "addRichTextTargets" o = TargetListAddRichTextTargetsMethodInfo
    ResolveTargetListMethod "addTable" o = TargetListAddTableMethodInfo
    ResolveTargetListMethod "addTextTargets" o = TargetListAddTextTargetsMethodInfo
    ResolveTargetListMethod "addUriTargets" o = TargetListAddUriTargetsMethodInfo
    ResolveTargetListMethod "find" o = TargetListFindMethodInfo
    ResolveTargetListMethod "ref" o = TargetListRefMethodInfo
    ResolveTargetListMethod "remove" o = TargetListRemoveMethodInfo
    ResolveTargetListMethod "unref" o = TargetListUnrefMethodInfo
    ResolveTargetListMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif