{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.Gtk.Structs.IconSource
    ( 
    IconSource(..)                          ,
 
#if defined(ENABLE_OVERLOADING)
    ResolveIconSourceMethod                 ,
#endif
#if defined(ENABLE_OVERLOADING)
    IconSourceCopyMethodInfo                ,
#endif
    iconSourceCopy                          ,
#if defined(ENABLE_OVERLOADING)
    IconSourceFreeMethodInfo                ,
#endif
    iconSourceFree                          ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetDirectionMethodInfo        ,
#endif
    iconSourceGetDirection                  ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetDirectionWildcardedMethodInfo,
#endif
    iconSourceGetDirectionWildcarded        ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetFilenameMethodInfo         ,
#endif
    iconSourceGetFilename                   ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetIconNameMethodInfo         ,
#endif
    iconSourceGetIconName                   ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetPixbufMethodInfo           ,
#endif
    iconSourceGetPixbuf                     ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetSizeMethodInfo             ,
#endif
    iconSourceGetSize                       ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetSizeWildcardedMethodInfo   ,
#endif
    iconSourceGetSizeWildcarded             ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetStateMethodInfo            ,
#endif
    iconSourceGetState                      ,
#if defined(ENABLE_OVERLOADING)
    IconSourceGetStateWildcardedMethodInfo  ,
#endif
    iconSourceGetStateWildcarded            ,
    iconSourceNew                           ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetDirectionMethodInfo        ,
#endif
    iconSourceSetDirection                  ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetDirectionWildcardedMethodInfo,
#endif
    iconSourceSetDirectionWildcarded        ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetFilenameMethodInfo         ,
#endif
    iconSourceSetFilename                   ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetIconNameMethodInfo         ,
#endif
    iconSourceSetIconName                   ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetPixbufMethodInfo           ,
#endif
    iconSourceSetPixbuf                     ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetSizeMethodInfo             ,
#endif
    iconSourceSetSize                       ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetSizeWildcardedMethodInfo   ,
#endif
    iconSourceSetSizeWildcarded             ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetStateMethodInfo            ,
#endif
    iconSourceSetState                      ,
#if defined(ENABLE_OVERLOADING)
    IconSourceSetStateWildcardedMethodInfo  ,
#endif
    iconSourceSetStateWildcarded            ,
    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
newtype IconSource = IconSource (ManagedPtr IconSource)
    deriving (IconSource -> IconSource -> Bool
(IconSource -> IconSource -> Bool)
-> (IconSource -> IconSource -> Bool) -> Eq IconSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IconSource -> IconSource -> Bool
$c/= :: IconSource -> IconSource -> Bool
== :: IconSource -> IconSource -> Bool
$c== :: IconSource -> IconSource -> Bool
Eq)
foreign import ccall "gtk_icon_source_get_type" c_gtk_icon_source_get_type :: 
    IO GType
instance BoxedObject IconSource where
    boxedType :: IconSource -> IO GType
boxedType IconSource
_ = IO GType
c_gtk_icon_source_get_type
instance B.GValue.IsGValue IconSource where
    toGValue :: IconSource -> IO GValue
toGValue IconSource
o = do
        GType
gtype <- IO GType
c_gtk_icon_source_get_type
        IconSource -> (Ptr IconSource -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr IconSource
o (GType
-> (GValue -> Ptr IconSource -> IO ())
-> Ptr IconSource
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr IconSource -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO IconSource
fromGValue GValue
gv = do
        Ptr IconSource
ptr <- GValue -> IO (Ptr IconSource)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr IconSource)
        (ManagedPtr IconSource -> IconSource)
-> Ptr IconSource -> IO IconSource
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr IconSource -> IconSource
IconSource Ptr IconSource
ptr
        
    
#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IconSource
type instance O.AttributeList IconSource = IconSourceAttributeList
type IconSourceAttributeList = ('[ ] :: [(Symbol, *)])
#endif
foreign import ccall "gtk_icon_source_new" gtk_icon_source_new :: 
    IO (Ptr IconSource)
{-# DEPRECATED iconSourceNew ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m IconSource
    
iconSourceNew :: m IconSource
iconSourceNew  = IO IconSource -> m IconSource
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconSource -> m IconSource) -> IO IconSource -> m IconSource
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
result <- IO (Ptr IconSource)
gtk_icon_source_new
    Text -> Ptr IconSource -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconSourceNew" Ptr IconSource
result
    IconSource
result' <- ((ManagedPtr IconSource -> IconSource)
-> Ptr IconSource -> IO IconSource
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IconSource -> IconSource
IconSource) Ptr IconSource
result
    IconSource -> IO IconSource
forall (m :: * -> *) a. Monad m => a -> m a
return IconSource
result'
#if defined(ENABLE_OVERLOADING)
#endif
foreign import ccall "gtk_icon_source_copy" gtk_icon_source_copy :: 
    Ptr IconSource ->                       
    IO (Ptr IconSource)
{-# DEPRECATED iconSourceCopy ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m IconSource
    
iconSourceCopy :: IconSource -> m IconSource
iconSourceCopy IconSource
source = IO IconSource -> m IconSource
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconSource -> m IconSource) -> IO IconSource -> m IconSource
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    Ptr IconSource
result <- Ptr IconSource -> IO (Ptr IconSource)
gtk_icon_source_copy Ptr IconSource
source'
    Text -> Ptr IconSource -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconSourceCopy" Ptr IconSource
result
    IconSource
result' <- ((ManagedPtr IconSource -> IconSource)
-> Ptr IconSource -> IO IconSource
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr IconSource -> IconSource
IconSource) Ptr IconSource
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    IconSource -> IO IconSource
forall (m :: * -> *) a. Monad m => a -> m a
return IconSource
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceCopyMethodInfo
instance (signature ~ (m IconSource), MonadIO m) => O.MethodInfo IconSourceCopyMethodInfo IconSource signature where
    overloadedMethod = iconSourceCopy
#endif
foreign import ccall "gtk_icon_source_free" gtk_icon_source_free :: 
    Ptr IconSource ->                       
    IO ()
{-# DEPRECATED iconSourceFree ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m ()
iconSourceFree :: IconSource -> m ()
iconSourceFree IconSource
source = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    Ptr IconSource -> IO ()
gtk_icon_source_free Ptr IconSource
source'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo IconSourceFreeMethodInfo IconSource signature where
    overloadedMethod = iconSourceFree
#endif
foreign import ccall "gtk_icon_source_get_direction" gtk_icon_source_get_direction :: 
    Ptr IconSource ->                       
    IO CUInt
{-# DEPRECATED iconSourceGetDirection ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetDirection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m Gtk.Enums.TextDirection
    
iconSourceGetDirection :: IconSource -> m TextDirection
iconSourceGetDirection IconSource
source = IO TextDirection -> m TextDirection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TextDirection -> m TextDirection)
-> IO TextDirection -> m TextDirection
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CUInt
result <- Ptr IconSource -> IO CUInt
gtk_icon_source_get_direction Ptr IconSource
source'
    let result' :: TextDirection
result' = (Int -> TextDirection
forall a. Enum a => Int -> a
toEnum (Int -> TextDirection) -> (CUInt -> Int) -> CUInt -> TextDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    TextDirection -> IO TextDirection
forall (m :: * -> *) a. Monad m => a -> m a
return TextDirection
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetDirectionMethodInfo
instance (signature ~ (m Gtk.Enums.TextDirection), MonadIO m) => O.MethodInfo IconSourceGetDirectionMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetDirection
#endif
foreign import ccall "gtk_icon_source_get_direction_wildcarded" gtk_icon_source_get_direction_wildcarded :: 
    Ptr IconSource ->                       
    IO CInt
{-# DEPRECATED iconSourceGetDirectionWildcarded ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetDirectionWildcarded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m Bool
    
iconSourceGetDirectionWildcarded :: IconSource -> m Bool
iconSourceGetDirectionWildcarded IconSource
source = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CInt
result <- Ptr IconSource -> IO CInt
gtk_icon_source_get_direction_wildcarded Ptr IconSource
source'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetDirectionWildcardedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo IconSourceGetDirectionWildcardedMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetDirectionWildcarded
#endif
foreign import ccall "gtk_icon_source_get_filename" gtk_icon_source_get_filename :: 
    Ptr IconSource ->                       
    IO CString
{-# DEPRECATED iconSourceGetFilename ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetFilename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m [Char]
    
    
iconSourceGetFilename :: IconSource -> m [Char]
iconSourceGetFilename IconSource
source = IO [Char] -> m [Char]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CString
result <- Ptr IconSource -> IO CString
gtk_icon_source_get_filename Ptr IconSource
source'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconSourceGetFilename" CString
result
    [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetFilenameMethodInfo
instance (signature ~ (m [Char]), MonadIO m) => O.MethodInfo IconSourceGetFilenameMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetFilename
#endif
foreign import ccall "gtk_icon_source_get_icon_name" gtk_icon_source_get_icon_name :: 
    Ptr IconSource ->                       
    IO CString
{-# DEPRECATED iconSourceGetIconName ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m T.Text
    
iconSourceGetIconName :: IconSource -> m Text
iconSourceGetIconName IconSource
source = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CString
result <- Ptr IconSource -> IO CString
gtk_icon_source_get_icon_name Ptr IconSource
source'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconSourceGetIconName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetIconNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo IconSourceGetIconNameMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetIconName
#endif
foreign import ccall "gtk_icon_source_get_pixbuf" gtk_icon_source_get_pixbuf :: 
    Ptr IconSource ->                       
    IO (Ptr GdkPixbuf.Pixbuf.Pixbuf)
{-# DEPRECATED iconSourceGetPixbuf ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m GdkPixbuf.Pixbuf.Pixbuf
    
iconSourceGetPixbuf :: IconSource -> m Pixbuf
iconSourceGetPixbuf IconSource
source = IO Pixbuf -> m Pixbuf
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pixbuf -> m Pixbuf) -> IO Pixbuf -> m Pixbuf
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    Ptr Pixbuf
result <- Ptr IconSource -> IO (Ptr Pixbuf)
gtk_icon_source_get_pixbuf Ptr IconSource
source'
    Text -> Ptr Pixbuf -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconSourceGetPixbuf" Ptr Pixbuf
result
    Pixbuf
result' <- ((ManagedPtr Pixbuf -> Pixbuf) -> Ptr Pixbuf -> IO Pixbuf
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Pixbuf -> Pixbuf
GdkPixbuf.Pixbuf.Pixbuf) Ptr Pixbuf
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    Pixbuf -> IO Pixbuf
forall (m :: * -> *) a. Monad m => a -> m a
return Pixbuf
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetPixbufMethodInfo
instance (signature ~ (m GdkPixbuf.Pixbuf.Pixbuf), MonadIO m) => O.MethodInfo IconSourceGetPixbufMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetPixbuf
#endif
foreign import ccall "gtk_icon_source_get_size" gtk_icon_source_get_size :: 
    Ptr IconSource ->                       
    IO Int32
{-# DEPRECATED iconSourceGetSize ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m Int32
    
iconSourceGetSize :: IconSource -> m Int32
iconSourceGetSize IconSource
source = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    Int32
result <- Ptr IconSource -> IO Int32
gtk_icon_source_get_size Ptr IconSource
source'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
#if defined(ENABLE_OVERLOADING)
data IconSourceGetSizeMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.MethodInfo IconSourceGetSizeMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetSize
#endif
foreign import ccall "gtk_icon_source_get_size_wildcarded" gtk_icon_source_get_size_wildcarded :: 
    Ptr IconSource ->                       
    IO CInt
{-# DEPRECATED iconSourceGetSizeWildcarded ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetSizeWildcarded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m Bool
    
iconSourceGetSizeWildcarded :: IconSource -> m Bool
iconSourceGetSizeWildcarded IconSource
source = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CInt
result <- Ptr IconSource -> IO CInt
gtk_icon_source_get_size_wildcarded Ptr IconSource
source'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetSizeWildcardedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo IconSourceGetSizeWildcardedMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetSizeWildcarded
#endif
foreign import ccall "gtk_icon_source_get_state" gtk_icon_source_get_state :: 
    Ptr IconSource ->                       
    IO CUInt
{-# DEPRECATED iconSourceGetState ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetState ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m Gtk.Enums.StateType
    
iconSourceGetState :: IconSource -> m StateType
iconSourceGetState IconSource
source = IO StateType -> m StateType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StateType -> m StateType) -> IO StateType -> m StateType
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CUInt
result <- Ptr IconSource -> IO CUInt
gtk_icon_source_get_state Ptr IconSource
source'
    let result' :: StateType
result' = (Int -> StateType
forall a. Enum a => Int -> a
toEnum (Int -> StateType) -> (CUInt -> Int) -> CUInt -> StateType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    StateType -> IO StateType
forall (m :: * -> *) a. Monad m => a -> m a
return StateType
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetStateMethodInfo
instance (signature ~ (m Gtk.Enums.StateType), MonadIO m) => O.MethodInfo IconSourceGetStateMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetState
#endif
foreign import ccall "gtk_icon_source_get_state_wildcarded" gtk_icon_source_get_state_wildcarded :: 
    Ptr IconSource ->                       
    IO CInt
{-# DEPRECATED iconSourceGetStateWildcarded ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceGetStateWildcarded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> m Bool
    
iconSourceGetStateWildcarded :: IconSource -> m Bool
iconSourceGetStateWildcarded IconSource
source = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CInt
result <- Ptr IconSource -> IO CInt
gtk_icon_source_get_state_wildcarded Ptr IconSource
source'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'
#if defined(ENABLE_OVERLOADING)
data IconSourceGetStateWildcardedMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo IconSourceGetStateWildcardedMethodInfo IconSource signature where
    overloadedMethod = iconSourceGetStateWildcarded
#endif
foreign import ccall "gtk_icon_source_set_direction" gtk_icon_source_set_direction :: 
    Ptr IconSource ->                       
    CUInt ->                                
    IO ()
{-# DEPRECATED iconSourceSetDirection ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetDirection ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Gtk.Enums.TextDirection
    
    -> m ()
iconSourceSetDirection :: IconSource -> TextDirection -> m ()
iconSourceSetDirection IconSource
source TextDirection
direction = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    let direction' :: CUInt
direction' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (TextDirection -> Int) -> TextDirection -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextDirection -> Int
forall a. Enum a => a -> Int
fromEnum) TextDirection
direction
    Ptr IconSource -> CUInt -> IO ()
gtk_icon_source_set_direction Ptr IconSource
source' CUInt
direction'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetDirectionMethodInfo
instance (signature ~ (Gtk.Enums.TextDirection -> m ()), MonadIO m) => O.MethodInfo IconSourceSetDirectionMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetDirection
#endif
foreign import ccall "gtk_icon_source_set_direction_wildcarded" gtk_icon_source_set_direction_wildcarded :: 
    Ptr IconSource ->                       
    CInt ->                                 
    IO ()
{-# DEPRECATED iconSourceSetDirectionWildcarded ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetDirectionWildcarded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Bool
    
    -> m ()
iconSourceSetDirectionWildcarded :: IconSource -> Bool -> m ()
iconSourceSetDirectionWildcarded IconSource
source Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
setting
    Ptr IconSource -> CInt -> IO ()
gtk_icon_source_set_direction_wildcarded Ptr IconSource
source' CInt
setting'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetDirectionWildcardedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo IconSourceSetDirectionWildcardedMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetDirectionWildcarded
#endif
foreign import ccall "gtk_icon_source_set_filename" gtk_icon_source_set_filename :: 
    Ptr IconSource ->                       
    CString ->                              
    IO ()
{-# DEPRECATED iconSourceSetFilename ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetFilename ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> [Char]
    
    -> m ()
iconSourceSetFilename :: IconSource -> [Char] -> m ()
iconSourceSetFilename IconSource
source [Char]
filename = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CString
filename' <- [Char] -> IO CString
stringToCString [Char]
filename
    Ptr IconSource -> CString -> IO ()
gtk_icon_source_set_filename Ptr IconSource
source' CString
filename'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetFilenameMethodInfo
instance (signature ~ ([Char] -> m ()), MonadIO m) => O.MethodInfo IconSourceSetFilenameMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetFilename
#endif
foreign import ccall "gtk_icon_source_set_icon_name" gtk_icon_source_set_icon_name :: 
    Ptr IconSource ->                       
    CString ->                              
    IO ()
{-# DEPRECATED iconSourceSetIconName ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetIconName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Maybe (T.Text)
    
    -> m ()
iconSourceSetIconName :: IconSource -> Maybe Text -> m ()
iconSourceSetIconName IconSource
source Maybe Text
iconName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    CString
maybeIconName <- case Maybe Text
iconName of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jIconName -> do
            CString
jIconName' <- Text -> IO CString
textToCString Text
jIconName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconName'
    Ptr IconSource -> CString -> IO ()
gtk_icon_source_set_icon_name Ptr IconSource
source' CString
maybeIconName
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconName
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetIconNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m) => O.MethodInfo IconSourceSetIconNameMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetIconName
#endif
foreign import ccall "gtk_icon_source_set_pixbuf" gtk_icon_source_set_pixbuf :: 
    Ptr IconSource ->                       
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          
    IO ()
{-# DEPRECATED iconSourceSetPixbuf ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) =>
    IconSource
    
    -> a
    
    -> m ()
iconSourceSetPixbuf :: IconSource -> a -> m ()
iconSourceSetPixbuf IconSource
source a
pixbuf = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    Ptr Pixbuf
pixbuf' <- a -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pixbuf
    Ptr IconSource -> Ptr Pixbuf -> IO ()
gtk_icon_source_set_pixbuf Ptr IconSource
source' Ptr Pixbuf
pixbuf'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pixbuf
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetPixbufMethodInfo
instance (signature ~ (a -> m ()), MonadIO m, GdkPixbuf.Pixbuf.IsPixbuf a) => O.MethodInfo IconSourceSetPixbufMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetPixbuf
#endif
foreign import ccall "gtk_icon_source_set_size" gtk_icon_source_set_size :: 
    Ptr IconSource ->                       
    Int32 ->                                
    IO ()
{-# DEPRECATED iconSourceSetSize ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Int32
    
    -> m ()
iconSourceSetSize :: IconSource -> Int32 -> m ()
iconSourceSetSize IconSource
source Int32
size = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    Ptr IconSource -> Int32 -> IO ()
gtk_icon_source_set_size Ptr IconSource
source' Int32
size
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetSizeMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m) => O.MethodInfo IconSourceSetSizeMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetSize
#endif
foreign import ccall "gtk_icon_source_set_size_wildcarded" gtk_icon_source_set_size_wildcarded :: 
    Ptr IconSource ->                       
    CInt ->                                 
    IO ()
{-# DEPRECATED iconSourceSetSizeWildcarded ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetSizeWildcarded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Bool
    
    -> m ()
iconSourceSetSizeWildcarded :: IconSource -> Bool -> m ()
iconSourceSetSizeWildcarded IconSource
source Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
setting
    Ptr IconSource -> CInt -> IO ()
gtk_icon_source_set_size_wildcarded Ptr IconSource
source' CInt
setting'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetSizeWildcardedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo IconSourceSetSizeWildcardedMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetSizeWildcarded
#endif
foreign import ccall "gtk_icon_source_set_state" gtk_icon_source_set_state :: 
    Ptr IconSource ->                       
    CUInt ->                                
    IO ()
{-# DEPRECATED iconSourceSetState ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetState ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Gtk.Enums.StateType
    
    -> m ()
iconSourceSetState :: IconSource -> StateType -> m ()
iconSourceSetState IconSource
source StateType
state = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    let state' :: CUInt
state' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (StateType -> Int) -> StateType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateType -> Int
forall a. Enum a => a -> Int
fromEnum) StateType
state
    Ptr IconSource -> CUInt -> IO ()
gtk_icon_source_set_state Ptr IconSource
source' CUInt
state'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetStateMethodInfo
instance (signature ~ (Gtk.Enums.StateType -> m ()), MonadIO m) => O.MethodInfo IconSourceSetStateMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetState
#endif
foreign import ccall "gtk_icon_source_set_state_wildcarded" gtk_icon_source_set_state_wildcarded :: 
    Ptr IconSource ->                       
    CInt ->                                 
    IO ()
{-# DEPRECATED iconSourceSetStateWildcarded ["(Since version 3.10)","Use t'GI.Gtk.Objects.IconTheme.IconTheme' instead."] #-}
iconSourceSetStateWildcarded ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    IconSource
    
    -> Bool
    
    -> m ()
iconSourceSetStateWildcarded :: IconSource -> Bool -> m ()
iconSourceSetStateWildcarded IconSource
source Bool
setting = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconSource
source' <- IconSource -> IO (Ptr IconSource)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr IconSource
source
    let setting' :: CInt
setting' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
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
fromEnum) Bool
setting
    Ptr IconSource -> CInt -> IO ()
gtk_icon_source_set_state_wildcarded Ptr IconSource
source' CInt
setting'
    IconSource -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr IconSource
source
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#if defined(ENABLE_OVERLOADING)
data IconSourceSetStateWildcardedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo IconSourceSetStateWildcardedMethodInfo IconSource signature where
    overloadedMethod = iconSourceSetStateWildcarded
#endif
#if defined(ENABLE_OVERLOADING)
type family ResolveIconSourceMethod (t :: Symbol) (o :: *) :: * where
    ResolveIconSourceMethod "copy" o = IconSourceCopyMethodInfo
    ResolveIconSourceMethod "free" o = IconSourceFreeMethodInfo
    ResolveIconSourceMethod "getDirection" o = IconSourceGetDirectionMethodInfo
    ResolveIconSourceMethod "getDirectionWildcarded" o = IconSourceGetDirectionWildcardedMethodInfo
    ResolveIconSourceMethod "getFilename" o = IconSourceGetFilenameMethodInfo
    ResolveIconSourceMethod "getIconName" o = IconSourceGetIconNameMethodInfo
    ResolveIconSourceMethod "getPixbuf" o = IconSourceGetPixbufMethodInfo
    ResolveIconSourceMethod "getSize" o = IconSourceGetSizeMethodInfo
    ResolveIconSourceMethod "getSizeWildcarded" o = IconSourceGetSizeWildcardedMethodInfo
    ResolveIconSourceMethod "getState" o = IconSourceGetStateMethodInfo
    ResolveIconSourceMethod "getStateWildcarded" o = IconSourceGetStateWildcardedMethodInfo
    ResolveIconSourceMethod "setDirection" o = IconSourceSetDirectionMethodInfo
    ResolveIconSourceMethod "setDirectionWildcarded" o = IconSourceSetDirectionWildcardedMethodInfo
    ResolveIconSourceMethod "setFilename" o = IconSourceSetFilenameMethodInfo
    ResolveIconSourceMethod "setIconName" o = IconSourceSetIconNameMethodInfo
    ResolveIconSourceMethod "setPixbuf" o = IconSourceSetPixbufMethodInfo
    ResolveIconSourceMethod "setSize" o = IconSourceSetSizeMethodInfo
    ResolveIconSourceMethod "setSizeWildcarded" o = IconSourceSetSizeWildcardedMethodInfo
    ResolveIconSourceMethod "setState" o = IconSourceSetStateMethodInfo
    ResolveIconSourceMethod "setStateWildcarded" o = IconSourceSetStateWildcardedMethodInfo
    ResolveIconSourceMethod l o = O.MethodResolutionFailed l o
instance (info ~ ResolveIconSourceMethod t IconSource, O.MethodInfo info IconSource p) => OL.IsLabel t (IconSource -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif
#endif