{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Contains information found when looking up an icon in @GtkIconTheme@.
-- 
-- @GtkIconPaintable@ implements @GdkPaintable@.

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

module GI.Gtk.Objects.IconPaintable
    ( 

-- * Exported types
    IconPaintable(..)                       ,
    IsIconPaintable                         ,
    toIconPaintable                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [computeConcreteSize]("GI.Gdk.Interfaces.Paintable#g:method:computeConcreteSize"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [invalidateContents]("GI.Gdk.Interfaces.Paintable#g:method:invalidateContents"), [invalidateSize]("GI.Gdk.Interfaces.Paintable#g:method:invalidateSize"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSymbolic]("GI.Gtk.Objects.IconPaintable#g:method:isSymbolic"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [snapshot]("GI.Gdk.Interfaces.Paintable#g:method:snapshot"), [snapshotSymbolic]("GI.Gtk.Interfaces.SymbolicPaintable#g:method:snapshotSymbolic"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getCurrentImage]("GI.Gdk.Interfaces.Paintable#g:method:getCurrentImage"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFile]("GI.Gtk.Objects.IconPaintable#g:method:getFile"), [getFlags]("GI.Gdk.Interfaces.Paintable#g:method:getFlags"), [getIconName]("GI.Gtk.Objects.IconPaintable#g:method:getIconName"), [getIntrinsicAspectRatio]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicAspectRatio"), [getIntrinsicHeight]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicHeight"), [getIntrinsicWidth]("GI.Gdk.Interfaces.Paintable#g:method:getIntrinsicWidth"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveIconPaintableMethod              ,
#endif

-- ** getFile #method:getFile#

#if defined(ENABLE_OVERLOADING)
    IconPaintableGetFileMethodInfo          ,
#endif
    iconPaintableGetFile                    ,


-- ** getIconName #method:getIconName#

#if defined(ENABLE_OVERLOADING)
    IconPaintableGetIconNameMethodInfo      ,
#endif
    iconPaintableGetIconName                ,


-- ** isSymbolic #method:isSymbolic#

#if defined(ENABLE_OVERLOADING)
    IconPaintableIsSymbolicMethodInfo       ,
#endif
    iconPaintableIsSymbolic                 ,


-- ** newForFile #method:newForFile#

    iconPaintableNewForFile                 ,




 -- * Properties


-- ** file #attr:file#
-- | The file representing the icon, if any.

#if defined(ENABLE_OVERLOADING)
    IconPaintableFilePropertyInfo           ,
#endif
    constructIconPaintableFile              ,
    getIconPaintableFile                    ,
#if defined(ENABLE_OVERLOADING)
    iconPaintableFile                       ,
#endif


-- ** iconName #attr:iconName#
-- | The icon name that was chosen during lookup.

#if defined(ENABLE_OVERLOADING)
    IconPaintableIconNamePropertyInfo       ,
#endif
    constructIconPaintableIconName          ,
    getIconPaintableIconName                ,
#if defined(ENABLE_OVERLOADING)
    iconPaintableIconName                   ,
#endif


-- ** isSymbolic #attr:isSymbolic#
-- | Whether the icon is symbolic or not.

#if defined(ENABLE_OVERLOADING)
    IconPaintableIsSymbolicPropertyInfo     ,
#endif
    constructIconPaintableIsSymbolic        ,
    getIconPaintableIsSymbolic              ,




    ) 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.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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.SymbolicPaintable as Gtk.SymbolicPaintable

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

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

foreign import ccall "gtk_icon_paintable_get_type"
    c_gtk_icon_paintable_get_type :: IO B.Types.GType

instance B.Types.TypedObject IconPaintable where
    glibType :: IO GType
glibType = IO GType
c_gtk_icon_paintable_get_type

instance B.Types.GObject IconPaintable

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

instance O.HasParentTypes IconPaintable
type instance O.ParentTypes IconPaintable = '[GObject.Object.Object, Gdk.Paintable.Paintable, Gtk.SymbolicPaintable.SymbolicPaintable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveIconPaintableMethod (t :: Symbol) (o :: *) :: * where
    ResolveIconPaintableMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIconPaintableMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIconPaintableMethod "computeConcreteSize" o = Gdk.Paintable.PaintableComputeConcreteSizeMethodInfo
    ResolveIconPaintableMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIconPaintableMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIconPaintableMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIconPaintableMethod "invalidateContents" o = Gdk.Paintable.PaintableInvalidateContentsMethodInfo
    ResolveIconPaintableMethod "invalidateSize" o = Gdk.Paintable.PaintableInvalidateSizeMethodInfo
    ResolveIconPaintableMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIconPaintableMethod "isSymbolic" o = IconPaintableIsSymbolicMethodInfo
    ResolveIconPaintableMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIconPaintableMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIconPaintableMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIconPaintableMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIconPaintableMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIconPaintableMethod "snapshot" o = Gdk.Paintable.PaintableSnapshotMethodInfo
    ResolveIconPaintableMethod "snapshotSymbolic" o = Gtk.SymbolicPaintable.SymbolicPaintableSnapshotSymbolicMethodInfo
    ResolveIconPaintableMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIconPaintableMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIconPaintableMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIconPaintableMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIconPaintableMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIconPaintableMethod "getCurrentImage" o = Gdk.Paintable.PaintableGetCurrentImageMethodInfo
    ResolveIconPaintableMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIconPaintableMethod "getFile" o = IconPaintableGetFileMethodInfo
    ResolveIconPaintableMethod "getFlags" o = Gdk.Paintable.PaintableGetFlagsMethodInfo
    ResolveIconPaintableMethod "getIconName" o = IconPaintableGetIconNameMethodInfo
    ResolveIconPaintableMethod "getIntrinsicAspectRatio" o = Gdk.Paintable.PaintableGetIntrinsicAspectRatioMethodInfo
    ResolveIconPaintableMethod "getIntrinsicHeight" o = Gdk.Paintable.PaintableGetIntrinsicHeightMethodInfo
    ResolveIconPaintableMethod "getIntrinsicWidth" o = Gdk.Paintable.PaintableGetIntrinsicWidthMethodInfo
    ResolveIconPaintableMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIconPaintableMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIconPaintableMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIconPaintableMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIconPaintableMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIconPaintableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "file"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@file@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconPaintableFile :: (IsIconPaintable o, MIO.MonadIO m, Gio.File.IsFile a) => a -> m (GValueConstruct o)
constructIconPaintableFile :: forall o (m :: * -> *) a.
(IsIconPaintable o, MonadIO m, IsFile a) =>
a -> m (GValueConstruct o)
constructIconPaintableFile a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"file" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data IconPaintableFilePropertyInfo
instance AttrInfo IconPaintableFilePropertyInfo where
    type AttrAllowedOps IconPaintableFilePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconPaintableFilePropertyInfo = IsIconPaintable
    type AttrSetTypeConstraint IconPaintableFilePropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint IconPaintableFilePropertyInfo = Gio.File.IsFile
    type AttrTransferType IconPaintableFilePropertyInfo = Gio.File.File
    type AttrGetType IconPaintableFilePropertyInfo = (Maybe Gio.File.File)
    type AttrLabel IconPaintableFilePropertyInfo = "file"
    type AttrOrigin IconPaintableFilePropertyInfo = IconPaintable
    attrGet = getIconPaintableFile
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructIconPaintableFile
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.IconPaintable.file"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-IconPaintable.html#g:attr:file"
        })
#endif

-- VVV Prop "icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' iconPaintable #iconName
-- @
getIconPaintableIconName :: (MonadIO m, IsIconPaintable o) => o -> m (Maybe T.Text)
getIconPaintableIconName :: forall (m :: * -> *) o.
(MonadIO m, IsIconPaintable o) =>
o -> m (Maybe Text)
getIconPaintableIconName o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"icon-name"

-- | Construct a `GValueConstruct` with valid value for the “@icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconPaintableIconName :: (IsIconPaintable o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructIconPaintableIconName :: forall o (m :: * -> *).
(IsIconPaintable o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructIconPaintableIconName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data IconPaintableIconNamePropertyInfo
instance AttrInfo IconPaintableIconNamePropertyInfo where
    type AttrAllowedOps IconPaintableIconNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IconPaintableIconNamePropertyInfo = IsIconPaintable
    type AttrSetTypeConstraint IconPaintableIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IconPaintableIconNamePropertyInfo = (~) T.Text
    type AttrTransferType IconPaintableIconNamePropertyInfo = T.Text
    type AttrGetType IconPaintableIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel IconPaintableIconNamePropertyInfo = "icon-name"
    type AttrOrigin IconPaintableIconNamePropertyInfo = IconPaintable
    attrGet = getIconPaintableIconName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructIconPaintableIconName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.IconPaintable.iconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-IconPaintable.html#g:attr:iconName"
        })
#endif

-- VVV Prop "is-symbolic"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@is-symbolic@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIconPaintableIsSymbolic :: (IsIconPaintable o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructIconPaintableIsSymbolic :: forall o (m :: * -> *).
(IsIconPaintable o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructIconPaintableIsSymbolic Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"is-symbolic" Bool
val

#if defined(ENABLE_OVERLOADING)
data IconPaintableIsSymbolicPropertyInfo
instance AttrInfo IconPaintableIsSymbolicPropertyInfo where
    type AttrAllowedOps IconPaintableIsSymbolicPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint IconPaintableIsSymbolicPropertyInfo = IsIconPaintable
    type AttrSetTypeConstraint IconPaintableIsSymbolicPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint IconPaintableIsSymbolicPropertyInfo = (~) Bool
    type AttrTransferType IconPaintableIsSymbolicPropertyInfo = Bool
    type AttrGetType IconPaintableIsSymbolicPropertyInfo = Bool
    type AttrLabel IconPaintableIsSymbolicPropertyInfo = "is-symbolic"
    type AttrOrigin IconPaintableIsSymbolicPropertyInfo = IconPaintable
    attrGet = getIconPaintableIsSymbolic
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructIconPaintableIsSymbolic
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.IconPaintable.isSymbolic"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-IconPaintable.html#g:attr:isSymbolic"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList IconPaintable
type instance O.AttributeList IconPaintable = IconPaintableAttributeList
type IconPaintableAttributeList = ('[ '("file", IconPaintableFilePropertyInfo), '("iconName", IconPaintableIconNamePropertyInfo), '("isSymbolic", IconPaintableIsSymbolicPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
iconPaintableFile :: AttrLabelProxy "file"
iconPaintableFile = AttrLabelProxy

iconPaintableIconName :: AttrLabelProxy "iconName"
iconPaintableIconName = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList IconPaintable = IconPaintableSignalList
type IconPaintableSignalList = ('[ '("invalidateContents", Gdk.Paintable.PaintableInvalidateContentsSignalInfo), '("invalidateSize", Gdk.Paintable.PaintableInvalidateSizeSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method IconPaintable::new_for_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GFile`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "desired icon size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "scale"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the desired scale" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gtk" , name = "IconPaintable" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_paintable_new_for_file" gtk_icon_paintable_new_for_file :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- size : TBasicType TInt
    Int32 ->                                -- scale : TBasicType TInt
    IO (Ptr IconPaintable)

-- | Creates a @GtkIconPaintable@ for a file with a given size and scale.
-- 
-- The icon can then be rendered by using it as a @GdkPaintable@.
iconPaintableNewForFile ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@file@/: a @GFile@
    -> Int32
    -- ^ /@size@/: desired icon size
    -> Int32
    -- ^ /@scale@/: the desired scale
    -> m IconPaintable
    -- ^ __Returns:__ a @GtkIconPaintable@ containing
    --   for the icon. Unref with 'GI.GObject.Objects.Object.objectUnref'
iconPaintableNewForFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> Int32 -> Int32 -> m IconPaintable
iconPaintableNewForFile a
file Int32
size Int32
scale = IO IconPaintable -> m IconPaintable
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IconPaintable -> m IconPaintable)
-> IO IconPaintable -> m IconPaintable
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr IconPaintable
result <- Ptr File -> Int32 -> Int32 -> IO (Ptr IconPaintable)
gtk_icon_paintable_new_for_file Ptr File
file' Int32
size Int32
scale
    Text -> Ptr IconPaintable -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"iconPaintableNewForFile" Ptr IconPaintable
result
    IconPaintable
result' <- ((ManagedPtr IconPaintable -> IconPaintable)
-> Ptr IconPaintable -> IO IconPaintable
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr IconPaintable -> IconPaintable
IconPaintable) Ptr IconPaintable
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    IconPaintable -> IO IconPaintable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IconPaintable
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method IconPaintable::get_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconPaintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkIconPaintable`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_paintable_get_file" gtk_icon_paintable_get_file :: 
    Ptr IconPaintable ->                    -- self : TInterface (Name {namespace = "Gtk", name = "IconPaintable"})
    IO (Ptr Gio.File.File)

-- | Gets the @GFile@ that was used to load the icon.
-- 
-- Returns 'P.Nothing' if the icon was not loaded from a file.
iconPaintableGetFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconPaintable a) =>
    a
    -- ^ /@self@/: a @GtkIconPaintable@
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the @GFile@ for the icon
iconPaintableGetFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIconPaintable a) =>
a -> m (Maybe File)
iconPaintableGetFile a
self = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconPaintable
self' <- a -> IO (Ptr IconPaintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr IconPaintable -> IO (Ptr File)
gtk_icon_paintable_get_file Ptr IconPaintable
self'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        File
result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data IconPaintableGetFileMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsIconPaintable a) => O.OverloadedMethod IconPaintableGetFileMethodInfo a signature where
    overloadedMethod = iconPaintableGetFile

instance O.OverloadedMethodInfo IconPaintableGetFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.IconPaintable.iconPaintableGetFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-IconPaintable.html#v:iconPaintableGetFile"
        })


#endif

-- method IconPaintable::get_icon_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "IconPaintable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkIconPaintable`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_icon_paintable_get_icon_name" gtk_icon_paintable_get_icon_name :: 
    Ptr IconPaintable ->                    -- self : TInterface (Name {namespace = "Gtk", name = "IconPaintable"})
    IO CString

-- | Get the icon name being used for this icon.
-- 
-- When an icon looked up in the icon theme was not available, the
-- icon theme may use fallback icons - either those specified to
-- 'GI.Gtk.Objects.IconTheme.iconThemeLookupIcon' or the always-available
-- \"image-missing\". The icon chosen is returned by this function.
-- 
-- If the icon was created without an icon theme, this function
-- returns 'P.Nothing'.
iconPaintableGetIconName ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconPaintable a) =>
    a
    -- ^ /@self@/: a @GtkIconPaintable@
    -> m (Maybe [Char])
    -- ^ __Returns:__ the themed icon-name for the
    --   icon, or 'P.Nothing' if its not a themed icon.
iconPaintableGetIconName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIconPaintable a) =>
a -> m (Maybe String)
iconPaintableGetIconName a
self = IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconPaintable
self' <- a -> IO (Ptr IconPaintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr IconPaintable -> IO CString
gtk_icon_paintable_get_icon_name Ptr IconPaintable
self'
    Maybe String
maybeResult <- CString -> (CString -> IO String) -> IO (Maybe String)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO String) -> IO (Maybe String))
-> (CString -> IO String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        String
result'' <- HasCallStack => CString -> IO String
CString -> IO String
cstringToString CString
result'
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
maybeResult

#if defined(ENABLE_OVERLOADING)
data IconPaintableGetIconNameMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsIconPaintable a) => O.OverloadedMethod IconPaintableGetIconNameMethodInfo a signature where
    overloadedMethod = iconPaintableGetIconName

instance O.OverloadedMethodInfo IconPaintableGetIconNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.IconPaintable.iconPaintableGetIconName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-IconPaintable.html#v:iconPaintableGetIconName"
        })


#endif

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

foreign import ccall "gtk_icon_paintable_is_symbolic" gtk_icon_paintable_is_symbolic :: 
    Ptr IconPaintable ->                    -- self : TInterface (Name {namespace = "Gtk", name = "IconPaintable"})
    IO CInt

-- | Checks if the icon is symbolic or not.
-- 
-- This currently uses only the file name and not the file contents
-- for determining this. This behaviour may change in the future.
-- 
-- Note that to render a symbolic @GtkIconPaintable@ properly (with
-- recoloring), you have to set its icon name on a @GtkImage@.
iconPaintableIsSymbolic ::
    (B.CallStack.HasCallStack, MonadIO m, IsIconPaintable a) =>
    a
    -- ^ /@self@/: a @GtkIconPaintable@
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the icon is symbolic, 'P.False' otherwise
iconPaintableIsSymbolic :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIconPaintable a) =>
a -> m Bool
iconPaintableIsSymbolic a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr IconPaintable
self' <- a -> IO (Ptr IconPaintable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr IconPaintable -> IO CInt
gtk_icon_paintable_is_symbolic Ptr IconPaintable
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IconPaintableIsSymbolicMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsIconPaintable a) => O.OverloadedMethod IconPaintableIsSymbolicMethodInfo a signature where
    overloadedMethod = iconPaintableIsSymbolic

instance O.OverloadedMethodInfo IconPaintableIsSymbolicMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.IconPaintable.iconPaintableIsSymbolic",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.6/docs/GI-Gtk-Objects-IconPaintable.html#v:iconPaintableIsSymbolic"
        })


#endif