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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- parent: Parent object.
-- priv: Internal data.
-- An application indicator represents the values that are needed to show a
-- unique status in the panel for an application.  In general, applications
-- should try to fit in the other indicators that are available on the
-- panel before using this.  But, sometimes it is necissary.

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

module GI.AyatanaAppIndicator3.Objects.Indicator
    ( 

-- * Exported types
    Indicator(..)                           ,
    IsIndicator                             ,
    toIndicator                             ,


 -- * 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"), [buildMenuFromDesktop]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:buildMenuFromDesktop"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [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
-- [getAttentionIcon]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getAttentionIcon"), [getAttentionIconDesc]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getAttentionIconDesc"), [getCategory]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getCategory"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getIcon]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getIcon"), [getIconDesc]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getIconDesc"), [getIconThemePath]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getIconThemePath"), [getId]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getId"), [getLabel]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getLabel"), [getLabelGuide]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getLabelGuide"), [getMenu]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getMenu"), [getOrderingIndex]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getOrderingIndex"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSecondaryActivateTarget]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getSecondaryActivateTarget"), [getStatus]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getStatus"), [getTitle]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:getTitle").
-- 
-- ==== Setters
-- [setAttentionIcon]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setAttentionIcon"), [setAttentionIconFull]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setAttentionIconFull"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setIcon]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setIcon"), [setIconFull]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setIconFull"), [setIconThemePath]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setIconThemePath"), [setLabel]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setLabel"), [setMenu]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setMenu"), [setOrderingIndex]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setOrderingIndex"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSecondaryActivateTarget]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setSecondaryActivateTarget"), [setStatus]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setStatus"), [setTitle]("GI.AyatanaAppIndicator3.Objects.Indicator#g:method:setTitle").

#if defined(ENABLE_OVERLOADING)
    ResolveIndicatorMethod                  ,
#endif

-- ** buildMenuFromDesktop #method:buildMenuFromDesktop#

#if defined(ENABLE_OVERLOADING)
    IndicatorBuildMenuFromDesktopMethodInfo ,
#endif
    indicatorBuildMenuFromDesktop           ,


-- ** getAttentionIcon #method:getAttentionIcon#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetAttentionIconMethodInfo     ,
#endif
    indicatorGetAttentionIcon               ,


-- ** getAttentionIconDesc #method:getAttentionIconDesc#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetAttentionIconDescMethodInfo ,
#endif
    indicatorGetAttentionIconDesc           ,


-- ** getCategory #method:getCategory#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetCategoryMethodInfo          ,
#endif
    indicatorGetCategory                    ,


-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetIconMethodInfo              ,
#endif
    indicatorGetIcon                        ,


-- ** getIconDesc #method:getIconDesc#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetIconDescMethodInfo          ,
#endif
    indicatorGetIconDesc                    ,


-- ** getIconThemePath #method:getIconThemePath#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetIconThemePathMethodInfo     ,
#endif
    indicatorGetIconThemePath               ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetIdMethodInfo                ,
#endif
    indicatorGetId                          ,


-- ** getLabel #method:getLabel#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetLabelMethodInfo             ,
#endif
    indicatorGetLabel                       ,


-- ** getLabelGuide #method:getLabelGuide#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetLabelGuideMethodInfo        ,
#endif
    indicatorGetLabelGuide                  ,


-- ** getMenu #method:getMenu#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetMenuMethodInfo              ,
#endif
    indicatorGetMenu                        ,


-- ** getOrderingIndex #method:getOrderingIndex#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetOrderingIndexMethodInfo     ,
#endif
    indicatorGetOrderingIndex               ,


-- ** getSecondaryActivateTarget #method:getSecondaryActivateTarget#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetSecondaryActivateTargetMethodInfo,
#endif
    indicatorGetSecondaryActivateTarget     ,


-- ** getStatus #method:getStatus#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetStatusMethodInfo            ,
#endif
    indicatorGetStatus                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    IndicatorGetTitleMethodInfo             ,
#endif
    indicatorGetTitle                       ,


-- ** new #method:new#

    indicatorNew                            ,


-- ** newWithPath #method:newWithPath#

    indicatorNewWithPath                    ,


-- ** setAttentionIcon #method:setAttentionIcon#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetAttentionIconMethodInfo     ,
#endif
    indicatorSetAttentionIcon               ,


-- ** setAttentionIconFull #method:setAttentionIconFull#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetAttentionIconFullMethodInfo ,
#endif
    indicatorSetAttentionIconFull           ,


-- ** setIcon #method:setIcon#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetIconMethodInfo              ,
#endif
    indicatorSetIcon                        ,


-- ** setIconFull #method:setIconFull#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetIconFullMethodInfo          ,
#endif
    indicatorSetIconFull                    ,


-- ** setIconThemePath #method:setIconThemePath#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetIconThemePathMethodInfo     ,
#endif
    indicatorSetIconThemePath               ,


-- ** setLabel #method:setLabel#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetLabelMethodInfo             ,
#endif
    indicatorSetLabel                       ,


-- ** setMenu #method:setMenu#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetMenuMethodInfo              ,
#endif
    indicatorSetMenu                        ,


-- ** setOrderingIndex #method:setOrderingIndex#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetOrderingIndexMethodInfo     ,
#endif
    indicatorSetOrderingIndex               ,


-- ** setSecondaryActivateTarget #method:setSecondaryActivateTarget#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetSecondaryActivateTargetMethodInfo,
#endif
    indicatorSetSecondaryActivateTarget     ,


-- ** setStatus #method:setStatus#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetStatusMethodInfo            ,
#endif
    indicatorSetStatus                      ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    IndicatorSetTitleMethodInfo             ,
#endif
    indicatorSetTitle                       ,




 -- * Properties


-- ** attentionIconDesc #attr:attentionIconDesc#
-- | If the indicator sets it\'s status to 'GI.AyatanaAppIndicator3.Enums.IndicatorStatusAttention'
-- then this textual description of the icon shown.

#if defined(ENABLE_OVERLOADING)
    IndicatorAttentionIconDescPropertyInfo  ,
#endif
    clearIndicatorAttentionIconDesc         ,
    constructIndicatorAttentionIconDesc     ,
    getIndicatorAttentionIconDesc           ,
#if defined(ENABLE_OVERLOADING)
    indicatorAttentionIconDesc              ,
#endif
    setIndicatorAttentionIconDesc           ,


-- ** attentionIconName #attr:attentionIconName#
-- | If the indicator sets it\'s status to 'GI.AyatanaAppIndicator3.Enums.IndicatorStatusAttention'
-- then this icon is shown.

#if defined(ENABLE_OVERLOADING)
    IndicatorAttentionIconNamePropertyInfo  ,
#endif
    clearIndicatorAttentionIconName         ,
    constructIndicatorAttentionIconName     ,
    getIndicatorAttentionIconName           ,
#if defined(ENABLE_OVERLOADING)
    indicatorAttentionIconName              ,
#endif
    setIndicatorAttentionIconName           ,


-- ** category #attr:category#
-- | The type of indicator that this represents.  Please don\'t use \'Other\'.
-- Defaults to \'ApplicationStatus\'.

#if defined(ENABLE_OVERLOADING)
    IndicatorCategoryPropertyInfo           ,
#endif
    constructIndicatorCategory              ,
    getIndicatorCategory                    ,
#if defined(ENABLE_OVERLOADING)
    indicatorCategory                       ,
#endif


-- ** connected #attr:connected#
-- | Pretty simple, 'P.True' if we have a reasonable expectation of being
-- displayed through this object. You should hide your TrayIcon if so.

#if defined(ENABLE_OVERLOADING)
    IndicatorConnectedPropertyInfo          ,
#endif
    getIndicatorConnected                   ,
#if defined(ENABLE_OVERLOADING)
    indicatorConnected                      ,
#endif


-- ** iconDesc #attr:iconDesc#
-- | The description of the regular icon that is shown for the indicator.

#if defined(ENABLE_OVERLOADING)
    IndicatorIconDescPropertyInfo           ,
#endif
    clearIndicatorIconDesc                  ,
    constructIndicatorIconDesc              ,
    getIndicatorIconDesc                    ,
#if defined(ENABLE_OVERLOADING)
    indicatorIconDesc                       ,
#endif
    setIndicatorIconDesc                    ,


-- ** iconName #attr:iconName#
-- | The name of the regular icon that is shown for the indicator.

#if defined(ENABLE_OVERLOADING)
    IndicatorIconNamePropertyInfo           ,
#endif
    clearIndicatorIconName                  ,
    constructIndicatorIconName              ,
    getIndicatorIconName                    ,
#if defined(ENABLE_OVERLOADING)
    indicatorIconName                       ,
#endif
    setIndicatorIconName                    ,


-- ** iconThemePath #attr:iconThemePath#
-- | An additional place to look for icon names that may be installed by the
-- application.

#if defined(ENABLE_OVERLOADING)
    IndicatorIconThemePathPropertyInfo      ,
#endif
    constructIndicatorIconThemePath         ,
    getIndicatorIconThemePath               ,
#if defined(ENABLE_OVERLOADING)
    indicatorIconThemePath                  ,
#endif
    setIndicatorIconThemePath               ,


-- ** id #attr:id#
-- | The ID for this indicator, which should be unique, but used consistently
-- by this program and its indicator.

#if defined(ENABLE_OVERLOADING)
    IndicatorIdPropertyInfo                 ,
#endif
    constructIndicatorId                    ,
    getIndicatorId                          ,
#if defined(ENABLE_OVERLOADING)
    indicatorId                             ,
#endif


-- ** label #attr:label#
-- | A label that can be shown next to the string in the application
-- indicator.  The label will not be shown unless there is an icon
-- as well.  The label is useful for numerical and other frequently
-- updated information.  In general, it shouldn\'t be shown unless a
-- user requests it as it can take up a significant amount of space
-- on the user\'s panel.  This may not be shown in all visualizations.

#if defined(ENABLE_OVERLOADING)
    IndicatorLabelPropertyInfo              ,
#endif
    clearIndicatorLabel                     ,
    constructIndicatorLabel                 ,
    getIndicatorLabel                       ,
#if defined(ENABLE_OVERLOADING)
    indicatorLabel                          ,
#endif
    setIndicatorLabel                       ,


-- ** labelGuide #attr:labelGuide#
-- | An optional string to provide guidance to the panel on how big
-- the [Indicator:label]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:label") string could get.  If this is set correctly
-- then the panel should never \'jiggle\' as the string adjusts through
-- out the range of options.  For instance, if you were providing a
-- percentage like \"54% thrust\" in [Indicator:label]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:label") you\'d want to
-- set this string to \"100% thrust\" to ensure space when Scotty can
-- get you enough power.

#if defined(ENABLE_OVERLOADING)
    IndicatorLabelGuidePropertyInfo         ,
#endif
    clearIndicatorLabelGuide                ,
    constructIndicatorLabelGuide            ,
    getIndicatorLabelGuide                  ,
#if defined(ENABLE_OVERLOADING)
    indicatorLabelGuide                     ,
#endif
    setIndicatorLabelGuide                  ,


-- ** orderingIndex #attr:orderingIndex#
-- | The ordering index is an odd parameter, and if you think you don\'t need
-- it you\'re probably right.  In general, the application indicator try
-- to place the applications in a recreatable place taking into account
-- which category they\'re in to try and group them.  But, there are some
-- cases where you\'d want to ensure indicators are next to each other.
-- To do that you can override the generated ordering index and replace it
-- with a new one.  Again, you probably don\'t want to be doing this, but
-- in case you do, this is the way.

#if defined(ENABLE_OVERLOADING)
    IndicatorOrderingIndexPropertyInfo      ,
#endif
    constructIndicatorOrderingIndex         ,
    getIndicatorOrderingIndex               ,
#if defined(ENABLE_OVERLOADING)
    indicatorOrderingIndex                  ,
#endif
    setIndicatorOrderingIndex               ,


-- ** status #attr:status#
-- | Whether the indicator is shown or requests attention. Defaults to
-- \'Passive\'.

#if defined(ENABLE_OVERLOADING)
    IndicatorStatusPropertyInfo             ,
#endif
    clearIndicatorStatus                    ,
    constructIndicatorStatus                ,
    getIndicatorStatus                      ,
#if defined(ENABLE_OVERLOADING)
    indicatorStatus                         ,
#endif
    setIndicatorStatus                      ,


-- ** title #attr:title#
-- | Provides a way to refer to this application indicator in a human
-- readable form.  This is used in the Unity desktop in the HUD as
-- the first part of the menu entries to distinguish them from the
-- focused application\'s entries.

#if defined(ENABLE_OVERLOADING)
    IndicatorTitlePropertyInfo              ,
#endif
    clearIndicatorTitle                     ,
    constructIndicatorTitle                 ,
    getIndicatorTitle                       ,
#if defined(ENABLE_OVERLOADING)
    indicatorTitle                          ,
#endif
    setIndicatorTitle                       ,




 -- * Signals


-- ** connectionChanged #signal:connectionChanged#

    IndicatorConnectionChangedCallback      ,
#if defined(ENABLE_OVERLOADING)
    IndicatorConnectionChangedSignalInfo    ,
#endif
    afterIndicatorConnectionChanged         ,
    onIndicatorConnectionChanged            ,


-- ** newAttentionIcon #signal:newAttentionIcon#

    IndicatorNewAttentionIconCallback       ,
#if defined(ENABLE_OVERLOADING)
    IndicatorNewAttentionIconSignalInfo     ,
#endif
    afterIndicatorNewAttentionIcon          ,
    onIndicatorNewAttentionIcon             ,


-- ** newIcon #signal:newIcon#

    IndicatorNewIconCallback                ,
#if defined(ENABLE_OVERLOADING)
    IndicatorNewIconSignalInfo              ,
#endif
    afterIndicatorNewIcon                   ,
    onIndicatorNewIcon                      ,


-- ** newIconThemePath #signal:newIconThemePath#

    IndicatorNewIconThemePathCallback       ,
#if defined(ENABLE_OVERLOADING)
    IndicatorNewIconThemePathSignalInfo     ,
#endif
    afterIndicatorNewIconThemePath          ,
    onIndicatorNewIconThemePath             ,


-- ** newLabel #signal:newLabel#

    IndicatorNewLabelCallback               ,
#if defined(ENABLE_OVERLOADING)
    IndicatorNewLabelSignalInfo             ,
#endif
    afterIndicatorNewLabel                  ,
    onIndicatorNewLabel                     ,


-- ** newStatus #signal:newStatus#

    IndicatorNewStatusCallback              ,
#if defined(ENABLE_OVERLOADING)
    IndicatorNewStatusSignalInfo            ,
#endif
    afterIndicatorNewStatus                 ,
    onIndicatorNewStatus                    ,


-- ** scrollEvent #signal:scrollEvent#

    IndicatorScrollEventCallback            ,
#if defined(ENABLE_OVERLOADING)
    IndicatorScrollEventSignalInfo          ,
#endif
    afterIndicatorScrollEvent               ,
    onIndicatorScrollEvent                  ,




    ) 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 {-# SOURCE #-} qualified GI.AyatanaAppIndicator3.Enums as AyatanaAppIndicator3.Enums
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Enums as Gdk.Enums
import qualified GI.Gtk.Objects.Menu as Gtk.Menu
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "app_indicator_get_type"
    c_app_indicator_get_type :: IO B.Types.GType

instance B.Types.TypedObject Indicator where
    glibType :: IO GType
glibType = IO GType
c_app_indicator_get_type

instance B.Types.GObject Indicator

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveIndicatorMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveIndicatorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIndicatorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIndicatorMethod "buildMenuFromDesktop" o = IndicatorBuildMenuFromDesktopMethodInfo
    ResolveIndicatorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIndicatorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIndicatorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIndicatorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIndicatorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIndicatorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIndicatorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIndicatorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIndicatorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIndicatorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIndicatorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIndicatorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIndicatorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIndicatorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIndicatorMethod "getAttentionIcon" o = IndicatorGetAttentionIconMethodInfo
    ResolveIndicatorMethod "getAttentionIconDesc" o = IndicatorGetAttentionIconDescMethodInfo
    ResolveIndicatorMethod "getCategory" o = IndicatorGetCategoryMethodInfo
    ResolveIndicatorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIndicatorMethod "getIcon" o = IndicatorGetIconMethodInfo
    ResolveIndicatorMethod "getIconDesc" o = IndicatorGetIconDescMethodInfo
    ResolveIndicatorMethod "getIconThemePath" o = IndicatorGetIconThemePathMethodInfo
    ResolveIndicatorMethod "getId" o = IndicatorGetIdMethodInfo
    ResolveIndicatorMethod "getLabel" o = IndicatorGetLabelMethodInfo
    ResolveIndicatorMethod "getLabelGuide" o = IndicatorGetLabelGuideMethodInfo
    ResolveIndicatorMethod "getMenu" o = IndicatorGetMenuMethodInfo
    ResolveIndicatorMethod "getOrderingIndex" o = IndicatorGetOrderingIndexMethodInfo
    ResolveIndicatorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIndicatorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIndicatorMethod "getSecondaryActivateTarget" o = IndicatorGetSecondaryActivateTargetMethodInfo
    ResolveIndicatorMethod "getStatus" o = IndicatorGetStatusMethodInfo
    ResolveIndicatorMethod "getTitle" o = IndicatorGetTitleMethodInfo
    ResolveIndicatorMethod "setAttentionIcon" o = IndicatorSetAttentionIconMethodInfo
    ResolveIndicatorMethod "setAttentionIconFull" o = IndicatorSetAttentionIconFullMethodInfo
    ResolveIndicatorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIndicatorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIndicatorMethod "setIcon" o = IndicatorSetIconMethodInfo
    ResolveIndicatorMethod "setIconFull" o = IndicatorSetIconFullMethodInfo
    ResolveIndicatorMethod "setIconThemePath" o = IndicatorSetIconThemePathMethodInfo
    ResolveIndicatorMethod "setLabel" o = IndicatorSetLabelMethodInfo
    ResolveIndicatorMethod "setMenu" o = IndicatorSetMenuMethodInfo
    ResolveIndicatorMethod "setOrderingIndex" o = IndicatorSetOrderingIndexMethodInfo
    ResolveIndicatorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIndicatorMethod "setSecondaryActivateTarget" o = IndicatorSetSecondaryActivateTargetMethodInfo
    ResolveIndicatorMethod "setStatus" o = IndicatorSetStatusMethodInfo
    ResolveIndicatorMethod "setTitle" o = IndicatorSetTitleMethodInfo
    ResolveIndicatorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Indicator::connection-changed
-- | Signaled when we connect to a watcher, or when it drops away.
type IndicatorConnectionChangedCallback =
    Bool
    -- ^ /@arg1@/: Whether we\'re connected or not
    -> IO ()

type C_IndicatorConnectionChangedCallback =
    Ptr Indicator ->                        -- object
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorConnectionChangedCallback :: 
    GObject a => (a -> IndicatorConnectionChangedCallback) ->
    C_IndicatorConnectionChangedCallback
wrap_IndicatorConnectionChangedCallback :: forall a.
GObject a =>
(a -> IndicatorConnectionChangedCallback)
-> C_IndicatorConnectionChangedCallback
wrap_IndicatorConnectionChangedCallback a -> IndicatorConnectionChangedCallback
gi'cb Ptr Indicator
gi'selfPtr CInt
arg1 Ptr ()
_ = do
    let arg1' :: Bool
arg1' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
arg1
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IndicatorConnectionChangedCallback
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self)  Bool
arg1'


-- | Connect a signal handler for the [connectionChanged](#signal:connectionChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #connectionChanged callback
-- @
-- 
-- 
onIndicatorConnectionChanged :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorConnectionChangedCallback) -> m SignalHandlerId
onIndicatorConnectionChanged :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a
-> ((?self::a) => IndicatorConnectionChangedCallback)
-> m SignalHandlerId
onIndicatorConnectionChanged a
obj (?self::a) => IndicatorConnectionChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorConnectionChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorConnectionChangedCallback
IndicatorConnectionChangedCallback
cb
    let wrapped' :: C_IndicatorConnectionChangedCallback
wrapped' = (a -> IndicatorConnectionChangedCallback)
-> C_IndicatorConnectionChangedCallback
forall a.
GObject a =>
(a -> IndicatorConnectionChangedCallback)
-> C_IndicatorConnectionChangedCallback
wrap_IndicatorConnectionChangedCallback a -> IndicatorConnectionChangedCallback
wrapped
    FunPtr C_IndicatorConnectionChangedCallback
wrapped'' <- C_IndicatorConnectionChangedCallback
-> IO (FunPtr C_IndicatorConnectionChangedCallback)
mk_IndicatorConnectionChangedCallback C_IndicatorConnectionChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorConnectionChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"connection-changed" FunPtr C_IndicatorConnectionChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data IndicatorConnectionChangedSignalInfo
instance SignalInfo IndicatorConnectionChangedSignalInfo where
    type HaskellCallbackType IndicatorConnectionChangedSignalInfo = IndicatorConnectionChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorConnectionChangedCallback cb
        cb'' <- mk_IndicatorConnectionChangedCallback cb'
        connectSignalFunPtr obj "connection-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::connection-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:connectionChanged"})

#endif

-- signal Indicator::new-attention-icon
-- | Emitted when [Indicator:attentionIconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:attentionIconName") is changed
type IndicatorNewAttentionIconCallback =
    IO ()

type C_IndicatorNewAttentionIconCallback =
    Ptr Indicator ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorNewAttentionIconCallback :: 
    GObject a => (a -> IndicatorNewAttentionIconCallback) ->
    C_IndicatorNewAttentionIconCallback
wrap_IndicatorNewAttentionIconCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_IndicatorNewAttentionIconCallback
wrap_IndicatorNewAttentionIconCallback a -> IO ()
gi'cb Ptr Indicator
gi'selfPtr Ptr ()
_ = do
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IO ()
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self) 


-- | Connect a signal handler for the [newAttentionIcon](#signal:newAttentionIcon) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #newAttentionIcon callback
-- @
-- 
-- 
onIndicatorNewAttentionIcon :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewAttentionIconCallback) -> m SignalHandlerId
onIndicatorNewAttentionIcon :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onIndicatorNewAttentionIcon a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_IndicatorNewAttentionIconCallback
wrapped' = (a -> IO ()) -> C_IndicatorNewAttentionIconCallback
forall a.
GObject a =>
(a -> IO ()) -> C_IndicatorNewAttentionIconCallback
wrap_IndicatorNewAttentionIconCallback a -> IO ()
wrapped
    FunPtr C_IndicatorNewAttentionIconCallback
wrapped'' <- C_IndicatorNewAttentionIconCallback
-> IO (FunPtr C_IndicatorNewAttentionIconCallback)
mk_IndicatorNewAttentionIconCallback C_IndicatorNewAttentionIconCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewAttentionIconCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-attention-icon" FunPtr C_IndicatorNewAttentionIconCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [newAttentionIcon](#signal:newAttentionIcon) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' indicator #newAttentionIcon callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterIndicatorNewAttentionIcon :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewAttentionIconCallback) -> m SignalHandlerId
afterIndicatorNewAttentionIcon :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterIndicatorNewAttentionIcon a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_IndicatorNewAttentionIconCallback
wrapped' = (a -> IO ()) -> C_IndicatorNewAttentionIconCallback
forall a.
GObject a =>
(a -> IO ()) -> C_IndicatorNewAttentionIconCallback
wrap_IndicatorNewAttentionIconCallback a -> IO ()
wrapped
    FunPtr C_IndicatorNewAttentionIconCallback
wrapped'' <- C_IndicatorNewAttentionIconCallback
-> IO (FunPtr C_IndicatorNewAttentionIconCallback)
mk_IndicatorNewAttentionIconCallback C_IndicatorNewAttentionIconCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewAttentionIconCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-attention-icon" FunPtr C_IndicatorNewAttentionIconCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data IndicatorNewAttentionIconSignalInfo
instance SignalInfo IndicatorNewAttentionIconSignalInfo where
    type HaskellCallbackType IndicatorNewAttentionIconSignalInfo = IndicatorNewAttentionIconCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorNewAttentionIconCallback cb
        cb'' <- mk_IndicatorNewAttentionIconCallback cb'
        connectSignalFunPtr obj "new-attention-icon" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::new-attention-icon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:newAttentionIcon"})

#endif

-- signal Indicator::new-icon
-- | when [Indicator:iconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconName") is changed
type IndicatorNewIconCallback =
    IO ()

type C_IndicatorNewIconCallback =
    Ptr Indicator ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorNewIconCallback :: 
    GObject a => (a -> IndicatorNewIconCallback) ->
    C_IndicatorNewIconCallback
wrap_IndicatorNewIconCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_IndicatorNewAttentionIconCallback
wrap_IndicatorNewIconCallback a -> IO ()
gi'cb Ptr Indicator
gi'selfPtr Ptr ()
_ = do
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IO ()
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self) 


-- | Connect a signal handler for the [newIcon](#signal:newIcon) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #newIcon callback
-- @
-- 
-- 
onIndicatorNewIcon :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewIconCallback) -> m SignalHandlerId
onIndicatorNewIcon :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onIndicatorNewIcon a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_IndicatorNewAttentionIconCallback
wrapped' = (a -> IO ()) -> C_IndicatorNewAttentionIconCallback
forall a.
GObject a =>
(a -> IO ()) -> C_IndicatorNewAttentionIconCallback
wrap_IndicatorNewIconCallback a -> IO ()
wrapped
    FunPtr C_IndicatorNewAttentionIconCallback
wrapped'' <- C_IndicatorNewAttentionIconCallback
-> IO (FunPtr C_IndicatorNewAttentionIconCallback)
mk_IndicatorNewIconCallback C_IndicatorNewAttentionIconCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewAttentionIconCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-icon" FunPtr C_IndicatorNewAttentionIconCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data IndicatorNewIconSignalInfo
instance SignalInfo IndicatorNewIconSignalInfo where
    type HaskellCallbackType IndicatorNewIconSignalInfo = IndicatorNewIconCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorNewIconCallback cb
        cb'' <- mk_IndicatorNewIconCallback cb'
        connectSignalFunPtr obj "new-icon" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::new-icon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:newIcon"})

#endif

-- signal Indicator::new-icon-theme-path
-- | Signaled when there is a new icon set for the
-- object.
type IndicatorNewIconThemePathCallback =
    T.Text
    -- ^ /@arg1@/: The icon theme path
    -> IO ()

type C_IndicatorNewIconThemePathCallback =
    Ptr Indicator ->                        -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorNewIconThemePathCallback :: 
    GObject a => (a -> IndicatorNewIconThemePathCallback) ->
    C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewIconThemePathCallback :: forall a.
GObject a =>
(a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewIconThemePathCallback a -> IndicatorNewIconThemePathCallback
gi'cb Ptr Indicator
gi'selfPtr CString
arg1 Ptr ()
_ = do
    Text
arg1' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
arg1
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IndicatorNewIconThemePathCallback
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self)  Text
arg1'


-- | Connect a signal handler for the [newIconThemePath](#signal:newIconThemePath) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #newIconThemePath callback
-- @
-- 
-- 
onIndicatorNewIconThemePath :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewIconThemePathCallback) -> m SignalHandlerId
onIndicatorNewIconThemePath :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a
-> ((?self::a) => IndicatorNewIconThemePathCallback)
-> m SignalHandlerId
onIndicatorNewIconThemePath a
obj (?self::a) => IndicatorNewIconThemePathCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorNewIconThemePathCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorNewIconThemePathCallback
IndicatorNewIconThemePathCallback
cb
    let wrapped' :: C_IndicatorNewIconThemePathCallback
wrapped' = (a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
forall a.
GObject a =>
(a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewIconThemePathCallback a -> IndicatorNewIconThemePathCallback
wrapped
    FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' <- C_IndicatorNewIconThemePathCallback
-> IO (FunPtr C_IndicatorNewIconThemePathCallback)
mk_IndicatorNewIconThemePathCallback C_IndicatorNewIconThemePathCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewIconThemePathCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-icon-theme-path" FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [newIconThemePath](#signal:newIconThemePath) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' indicator #newIconThemePath callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterIndicatorNewIconThemePath :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewIconThemePathCallback) -> m SignalHandlerId
afterIndicatorNewIconThemePath :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a
-> ((?self::a) => IndicatorNewIconThemePathCallback)
-> m SignalHandlerId
afterIndicatorNewIconThemePath a
obj (?self::a) => IndicatorNewIconThemePathCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorNewIconThemePathCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorNewIconThemePathCallback
IndicatorNewIconThemePathCallback
cb
    let wrapped' :: C_IndicatorNewIconThemePathCallback
wrapped' = (a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
forall a.
GObject a =>
(a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewIconThemePathCallback a -> IndicatorNewIconThemePathCallback
wrapped
    FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' <- C_IndicatorNewIconThemePathCallback
-> IO (FunPtr C_IndicatorNewIconThemePathCallback)
mk_IndicatorNewIconThemePathCallback C_IndicatorNewIconThemePathCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewIconThemePathCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-icon-theme-path" FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data IndicatorNewIconThemePathSignalInfo
instance SignalInfo IndicatorNewIconThemePathSignalInfo where
    type HaskellCallbackType IndicatorNewIconThemePathSignalInfo = IndicatorNewIconThemePathCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorNewIconThemePathCallback cb
        cb'' <- mk_IndicatorNewIconThemePathCallback cb'
        connectSignalFunPtr obj "new-icon-theme-path" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::new-icon-theme-path"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:newIconThemePath"})

#endif

-- signal Indicator::new-label
-- | Emitted when either [Indicator:label]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:label") or [Indicator:labelGuide]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:labelGuide") are
-- changed.
type IndicatorNewLabelCallback =
    T.Text
    -- ^ /@arg1@/: The string for the label
    -> T.Text
    -- ^ /@arg2@/: The string for the guide
    -> IO ()

type C_IndicatorNewLabelCallback =
    Ptr Indicator ->                        -- object
    CString ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorNewLabelCallback :: 
    GObject a => (a -> IndicatorNewLabelCallback) ->
    C_IndicatorNewLabelCallback
wrap_IndicatorNewLabelCallback :: forall a.
GObject a =>
(a -> IndicatorNewLabelCallback) -> C_IndicatorNewLabelCallback
wrap_IndicatorNewLabelCallback a -> IndicatorNewLabelCallback
gi'cb Ptr Indicator
gi'selfPtr CString
arg1 CString
arg2 Ptr ()
_ = do
    Text
arg1' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
arg1
    Text
arg2' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
arg2
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IndicatorNewLabelCallback
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self)  Text
arg1' Text
arg2'


-- | Connect a signal handler for the [newLabel](#signal:newLabel) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #newLabel callback
-- @
-- 
-- 
onIndicatorNewLabel :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewLabelCallback) -> m SignalHandlerId
onIndicatorNewLabel :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a -> ((?self::a) => IndicatorNewLabelCallback) -> m SignalHandlerId
onIndicatorNewLabel a
obj (?self::a) => IndicatorNewLabelCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorNewLabelCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorNewLabelCallback
IndicatorNewLabelCallback
cb
    let wrapped' :: C_IndicatorNewLabelCallback
wrapped' = (a -> IndicatorNewLabelCallback) -> C_IndicatorNewLabelCallback
forall a.
GObject a =>
(a -> IndicatorNewLabelCallback) -> C_IndicatorNewLabelCallback
wrap_IndicatorNewLabelCallback a -> IndicatorNewLabelCallback
wrapped
    FunPtr C_IndicatorNewLabelCallback
wrapped'' <- C_IndicatorNewLabelCallback
-> IO (FunPtr C_IndicatorNewLabelCallback)
mk_IndicatorNewLabelCallback C_IndicatorNewLabelCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewLabelCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-label" FunPtr C_IndicatorNewLabelCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data IndicatorNewLabelSignalInfo
instance SignalInfo IndicatorNewLabelSignalInfo where
    type HaskellCallbackType IndicatorNewLabelSignalInfo = IndicatorNewLabelCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorNewLabelCallback cb
        cb'' <- mk_IndicatorNewLabelCallback cb'
        connectSignalFunPtr obj "new-label" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::new-label"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:newLabel"})

#endif

-- signal Indicator::new-status
-- | Emitted when [Indicator:status]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:status") is changed
type IndicatorNewStatusCallback =
    T.Text
    -- ^ /@arg1@/: The string value of the t'GI.AyatanaAppIndicator3.Enums.IndicatorStatus' enum.
    -> IO ()

type C_IndicatorNewStatusCallback =
    Ptr Indicator ->                        -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorNewStatusCallback :: 
    GObject a => (a -> IndicatorNewStatusCallback) ->
    C_IndicatorNewStatusCallback
wrap_IndicatorNewStatusCallback :: forall a.
GObject a =>
(a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewStatusCallback a -> IndicatorNewIconThemePathCallback
gi'cb Ptr Indicator
gi'selfPtr CString
arg1 Ptr ()
_ = do
    Text
arg1' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
arg1
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IndicatorNewIconThemePathCallback
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self)  Text
arg1'


-- | Connect a signal handler for the [newStatus](#signal:newStatus) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #newStatus callback
-- @
-- 
-- 
onIndicatorNewStatus :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewStatusCallback) -> m SignalHandlerId
onIndicatorNewStatus :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a
-> ((?self::a) => IndicatorNewIconThemePathCallback)
-> m SignalHandlerId
onIndicatorNewStatus a
obj (?self::a) => IndicatorNewIconThemePathCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorNewIconThemePathCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorNewIconThemePathCallback
IndicatorNewIconThemePathCallback
cb
    let wrapped' :: C_IndicatorNewIconThemePathCallback
wrapped' = (a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
forall a.
GObject a =>
(a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewStatusCallback a -> IndicatorNewIconThemePathCallback
wrapped
    FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' <- C_IndicatorNewIconThemePathCallback
-> IO (FunPtr C_IndicatorNewIconThemePathCallback)
mk_IndicatorNewStatusCallback C_IndicatorNewIconThemePathCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewIconThemePathCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-status" FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [newStatus](#signal:newStatus) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' indicator #newStatus callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterIndicatorNewStatus :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorNewStatusCallback) -> m SignalHandlerId
afterIndicatorNewStatus :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a
-> ((?self::a) => IndicatorNewIconThemePathCallback)
-> m SignalHandlerId
afterIndicatorNewStatus a
obj (?self::a) => IndicatorNewIconThemePathCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorNewIconThemePathCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorNewIconThemePathCallback
IndicatorNewIconThemePathCallback
cb
    let wrapped' :: C_IndicatorNewIconThemePathCallback
wrapped' = (a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
forall a.
GObject a =>
(a -> IndicatorNewIconThemePathCallback)
-> C_IndicatorNewIconThemePathCallback
wrap_IndicatorNewStatusCallback a -> IndicatorNewIconThemePathCallback
wrapped
    FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' <- C_IndicatorNewIconThemePathCallback
-> IO (FunPtr C_IndicatorNewIconThemePathCallback)
mk_IndicatorNewStatusCallback C_IndicatorNewIconThemePathCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorNewIconThemePathCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"new-status" FunPtr C_IndicatorNewIconThemePathCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data IndicatorNewStatusSignalInfo
instance SignalInfo IndicatorNewStatusSignalInfo where
    type HaskellCallbackType IndicatorNewStatusSignalInfo = IndicatorNewStatusCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorNewStatusCallback cb
        cb'' <- mk_IndicatorNewStatusCallback cb'
        connectSignalFunPtr obj "new-status" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::new-status"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:newStatus"})

#endif

-- signal Indicator::scroll-event
-- | Signaled when the t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' receives a scroll event.
type IndicatorScrollEventCallback =
    Int32
    -- ^ /@arg1@/: How many steps the scroll wheel has taken
    -> Gdk.Enums.ScrollDirection
    -- ^ /@arg2@/: Which direction the wheel went in
    -> IO ()

type C_IndicatorScrollEventCallback =
    Ptr Indicator ->                        -- object
    Int32 ->
    CUInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_IndicatorScrollEventCallback :: 
    GObject a => (a -> IndicatorScrollEventCallback) ->
    C_IndicatorScrollEventCallback
wrap_IndicatorScrollEventCallback :: forall a.
GObject a =>
(a -> IndicatorScrollEventCallback)
-> C_IndicatorScrollEventCallback
wrap_IndicatorScrollEventCallback a -> IndicatorScrollEventCallback
gi'cb Ptr Indicator
gi'selfPtr Int32
arg1 CUInt
arg2 Ptr ()
_ = do
    let arg2' :: ScrollDirection
arg2' = (Int -> ScrollDirection
forall a. Enum a => Int -> a
toEnum (Int -> ScrollDirection)
-> (CUInt -> Int) -> CUInt -> ScrollDirection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
arg2
    Ptr Indicator -> (Indicator -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Indicator
gi'selfPtr ((Indicator -> IO ()) -> IO ()) -> (Indicator -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Indicator
gi'self -> a -> IndicatorScrollEventCallback
gi'cb (Indicator -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Indicator
gi'self)  Int32
arg1 ScrollDirection
arg2'


-- | Connect a signal handler for the [scrollEvent](#signal:scrollEvent) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' indicator #scrollEvent callback
-- @
-- 
-- 
onIndicatorScrollEvent :: (IsIndicator a, MonadIO m) => a -> ((?self :: a) => IndicatorScrollEventCallback) -> m SignalHandlerId
onIndicatorScrollEvent :: forall a (m :: * -> *).
(IsIndicator a, MonadIO m) =>
a
-> ((?self::a) => IndicatorScrollEventCallback)
-> m SignalHandlerId
onIndicatorScrollEvent a
obj (?self::a) => IndicatorScrollEventCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IndicatorScrollEventCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => IndicatorScrollEventCallback
IndicatorScrollEventCallback
cb
    let wrapped' :: C_IndicatorScrollEventCallback
wrapped' = (a -> IndicatorScrollEventCallback)
-> C_IndicatorScrollEventCallback
forall a.
GObject a =>
(a -> IndicatorScrollEventCallback)
-> C_IndicatorScrollEventCallback
wrap_IndicatorScrollEventCallback a -> IndicatorScrollEventCallback
wrapped
    FunPtr C_IndicatorScrollEventCallback
wrapped'' <- C_IndicatorScrollEventCallback
-> IO (FunPtr C_IndicatorScrollEventCallback)
mk_IndicatorScrollEventCallback C_IndicatorScrollEventCallback
wrapped'
    a
-> Text
-> FunPtr C_IndicatorScrollEventCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"scroll-event" FunPtr C_IndicatorScrollEventCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

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


#if defined(ENABLE_OVERLOADING)
data IndicatorScrollEventSignalInfo
instance SignalInfo IndicatorScrollEventSignalInfo where
    type HaskellCallbackType IndicatorScrollEventSignalInfo = IndicatorScrollEventCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_IndicatorScrollEventCallback cb
        cb'' <- mk_IndicatorScrollEventCallback cb'
        connectSignalFunPtr obj "scroll-event" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator::scroll-event"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:signal:scrollEvent"})

#endif

-- VVV Prop "attention-icon-desc"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@attention-icon-desc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #attentionIconDesc
-- @
getIndicatorAttentionIconDesc :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorAttentionIconDesc :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorAttentionIconDesc o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorAttentionIconDesc" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"attention-icon-desc"

-- | Set the value of the “@attention-icon-desc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #attentionIconDesc 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorAttentionIconDesc :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorAttentionIconDesc :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorAttentionIconDesc o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"attention-icon-desc" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@attention-icon-desc@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIndicatorAttentionIconDesc :: (IsIndicator o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructIndicatorAttentionIconDesc :: forall o (m :: * -> *).
(IsIndicator o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructIndicatorAttentionIconDesc 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
"attention-icon-desc" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@attention-icon-desc@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #attentionIconDesc
-- @
clearIndicatorAttentionIconDesc :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorAttentionIconDesc :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorAttentionIconDesc o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"attention-icon-desc" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorAttentionIconDescPropertyInfo
instance AttrInfo IndicatorAttentionIconDescPropertyInfo where
    type AttrAllowedOps IndicatorAttentionIconDescPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorAttentionIconDescPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorAttentionIconDescPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorAttentionIconDescPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorAttentionIconDescPropertyInfo = T.Text
    type AttrGetType IndicatorAttentionIconDescPropertyInfo = T.Text
    type AttrLabel IndicatorAttentionIconDescPropertyInfo = "attention-icon-desc"
    type AttrOrigin IndicatorAttentionIconDescPropertyInfo = Indicator
    attrGet = getIndicatorAttentionIconDesc
    attrSet = setIndicatorAttentionIconDesc
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorAttentionIconDesc
    attrClear = clearIndicatorAttentionIconDesc
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.attentionIconDesc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:attentionIconDesc"
        })
#endif

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

-- | Get the value of the “@attention-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' indicator #attentionIconName
-- @
getIndicatorAttentionIconName :: (MonadIO m, IsIndicator o) => o -> m (Maybe T.Text)
getIndicatorAttentionIconName :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> m (Maybe Text)
getIndicatorAttentionIconName 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
"attention-icon-name"

-- | Set the value of the “@attention-icon-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #attentionIconName 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorAttentionIconName :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorAttentionIconName :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorAttentionIconName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"attention-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@attention-icon-name@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIndicatorAttentionIconName :: (IsIndicator o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructIndicatorAttentionIconName :: forall o (m :: * -> *).
(IsIndicator o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructIndicatorAttentionIconName 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
"attention-icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@attention-icon-name@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #attentionIconName
-- @
clearIndicatorAttentionIconName :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorAttentionIconName :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorAttentionIconName o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"attention-icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorAttentionIconNamePropertyInfo
instance AttrInfo IndicatorAttentionIconNamePropertyInfo where
    type AttrAllowedOps IndicatorAttentionIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorAttentionIconNamePropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorAttentionIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorAttentionIconNamePropertyInfo = (~) T.Text
    type AttrTransferType IndicatorAttentionIconNamePropertyInfo = T.Text
    type AttrGetType IndicatorAttentionIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel IndicatorAttentionIconNamePropertyInfo = "attention-icon-name"
    type AttrOrigin IndicatorAttentionIconNamePropertyInfo = Indicator
    attrGet = getIndicatorAttentionIconName
    attrSet = setIndicatorAttentionIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorAttentionIconName
    attrClear = clearIndicatorAttentionIconName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.attentionIconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:attentionIconName"
        })
#endif

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

-- | Get the value of the “@category@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #category
-- @
getIndicatorCategory :: (MonadIO m, IsIndicator o) => o -> m (Maybe T.Text)
getIndicatorCategory :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> m (Maybe Text)
getIndicatorCategory 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
"category"

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

#if defined(ENABLE_OVERLOADING)
data IndicatorCategoryPropertyInfo
instance AttrInfo IndicatorCategoryPropertyInfo where
    type AttrAllowedOps IndicatorCategoryPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorCategoryPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorCategoryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorCategoryPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorCategoryPropertyInfo = T.Text
    type AttrGetType IndicatorCategoryPropertyInfo = (Maybe T.Text)
    type AttrLabel IndicatorCategoryPropertyInfo = "category"
    type AttrOrigin IndicatorCategoryPropertyInfo = Indicator
    attrGet = getIndicatorCategory
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorCategory
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.category"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:category"
        })
#endif

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

-- | Get the value of the “@connected@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #connected
-- @
getIndicatorConnected :: (MonadIO m, IsIndicator o) => o -> m Bool
getIndicatorConnected :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Bool
getIndicatorConnected 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
"connected"

#if defined(ENABLE_OVERLOADING)
data IndicatorConnectedPropertyInfo
instance AttrInfo IndicatorConnectedPropertyInfo where
    type AttrAllowedOps IndicatorConnectedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint IndicatorConnectedPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorConnectedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint IndicatorConnectedPropertyInfo = (~) ()
    type AttrTransferType IndicatorConnectedPropertyInfo = ()
    type AttrGetType IndicatorConnectedPropertyInfo = Bool
    type AttrLabel IndicatorConnectedPropertyInfo = "connected"
    type AttrOrigin IndicatorConnectedPropertyInfo = Indicator
    attrGet = getIndicatorConnected
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.connected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:connected"
        })
#endif

-- VVV Prop "icon-desc"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@icon-desc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #iconDesc
-- @
getIndicatorIconDesc :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorIconDesc :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorIconDesc o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorIconDesc" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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-desc"

-- | Set the value of the “@icon-desc@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #iconDesc 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorIconDesc :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorIconDesc :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorIconDesc o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-desc" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@icon-desc@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #iconDesc
-- @
clearIndicatorIconDesc :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorIconDesc :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorIconDesc o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-desc" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorIconDescPropertyInfo
instance AttrInfo IndicatorIconDescPropertyInfo where
    type AttrAllowedOps IndicatorIconDescPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorIconDescPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorIconDescPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorIconDescPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorIconDescPropertyInfo = T.Text
    type AttrGetType IndicatorIconDescPropertyInfo = T.Text
    type AttrLabel IndicatorIconDescPropertyInfo = "icon-desc"
    type AttrOrigin IndicatorIconDescPropertyInfo = Indicator
    attrGet = getIndicatorIconDesc
    attrSet = setIndicatorIconDesc
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorIconDesc
    attrClear = clearIndicatorIconDesc
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.iconDesc"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:iconDesc"
        })
#endif

-- VVV Prop "icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- 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' indicator #iconName
-- @
getIndicatorIconName :: (MonadIO m, IsIndicator o) => o -> m (Maybe T.Text)
getIndicatorIconName :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> m (Maybe Text)
getIndicatorIconName 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"

-- | Set 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.set' indicator [ #iconName 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorIconName :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorIconName :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorIconName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | 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`.
constructIndicatorIconName :: (IsIndicator o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructIndicatorIconName :: forall o (m :: * -> *).
(IsIndicator o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructIndicatorIconName 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)

-- | Set the value of the “@icon-name@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #iconName
-- @
clearIndicatorIconName :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorIconName :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorIconName o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorIconNamePropertyInfo
instance AttrInfo IndicatorIconNamePropertyInfo where
    type AttrAllowedOps IndicatorIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorIconNamePropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorIconNamePropertyInfo = (~) T.Text
    type AttrTransferType IndicatorIconNamePropertyInfo = T.Text
    type AttrGetType IndicatorIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel IndicatorIconNamePropertyInfo = "icon-name"
    type AttrOrigin IndicatorIconNamePropertyInfo = Indicator
    attrGet = getIndicatorIconName
    attrSet = setIndicatorIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorIconName
    attrClear = clearIndicatorIconName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.iconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:iconName"
        })
#endif

-- VVV Prop "icon-theme-path"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@icon-theme-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #iconThemePath
-- @
getIndicatorIconThemePath :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorIconThemePath :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorIconThemePath o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorIconThemePath" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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-theme-path"

-- | Set the value of the “@icon-theme-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #iconThemePath 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorIconThemePath :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorIconThemePath :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorIconThemePath o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"icon-theme-path" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@icon-theme-path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIndicatorIconThemePath :: (IsIndicator o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructIndicatorIconThemePath :: forall o (m :: * -> *).
(IsIndicator o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructIndicatorIconThemePath 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-theme-path" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data IndicatorIconThemePathPropertyInfo
instance AttrInfo IndicatorIconThemePathPropertyInfo where
    type AttrAllowedOps IndicatorIconThemePathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint IndicatorIconThemePathPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorIconThemePathPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorIconThemePathPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorIconThemePathPropertyInfo = T.Text
    type AttrGetType IndicatorIconThemePathPropertyInfo = T.Text
    type AttrLabel IndicatorIconThemePathPropertyInfo = "icon-theme-path"
    type AttrOrigin IndicatorIconThemePathPropertyInfo = Indicator
    attrGet = getIndicatorIconThemePath
    attrSet = setIndicatorIconThemePath
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorIconThemePath
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.iconThemePath"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:iconThemePath"
        })
#endif

-- VVV Prop "id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #id
-- @
getIndicatorId :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorId :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorId o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorId" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"id"

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

#if defined(ENABLE_OVERLOADING)
data IndicatorIdPropertyInfo
instance AttrInfo IndicatorIdPropertyInfo where
    type AttrAllowedOps IndicatorIdPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorIdPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorIdPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorIdPropertyInfo = T.Text
    type AttrGetType IndicatorIdPropertyInfo = T.Text
    type AttrLabel IndicatorIdPropertyInfo = "id"
    type AttrOrigin IndicatorIdPropertyInfo = Indicator
    attrGet = getIndicatorId
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:id"
        })
#endif

-- VVV Prop "label"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #label
-- @
getIndicatorLabel :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorLabel :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorLabel o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorLabel" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"label"

-- | Set the value of the “@label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #label 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorLabel :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorLabel :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorLabel o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@label@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #label
-- @
clearIndicatorLabel :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorLabel :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorLabel o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"label" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorLabelPropertyInfo
instance AttrInfo IndicatorLabelPropertyInfo where
    type AttrAllowedOps IndicatorLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorLabelPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorLabelPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorLabelPropertyInfo = T.Text
    type AttrGetType IndicatorLabelPropertyInfo = T.Text
    type AttrLabel IndicatorLabelPropertyInfo = "label"
    type AttrOrigin IndicatorLabelPropertyInfo = Indicator
    attrGet = getIndicatorLabel
    attrSet = setIndicatorLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorLabel
    attrClear = clearIndicatorLabel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.label"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:label"
        })
#endif

-- VVV Prop "label-guide"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@label-guide@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #labelGuide
-- @
getIndicatorLabelGuide :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorLabelGuide :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorLabelGuide o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorLabelGuide" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"label-guide"

-- | Set the value of the “@label-guide@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #labelGuide 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorLabelGuide :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorLabelGuide :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorLabelGuide o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"label-guide" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@label-guide@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #labelGuide
-- @
clearIndicatorLabelGuide :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorLabelGuide :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorLabelGuide o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"label-guide" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorLabelGuidePropertyInfo
instance AttrInfo IndicatorLabelGuidePropertyInfo where
    type AttrAllowedOps IndicatorLabelGuidePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorLabelGuidePropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorLabelGuidePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorLabelGuidePropertyInfo = (~) T.Text
    type AttrTransferType IndicatorLabelGuidePropertyInfo = T.Text
    type AttrGetType IndicatorLabelGuidePropertyInfo = T.Text
    type AttrLabel IndicatorLabelGuidePropertyInfo = "label-guide"
    type AttrOrigin IndicatorLabelGuidePropertyInfo = Indicator
    attrGet = getIndicatorLabelGuide
    attrSet = setIndicatorLabelGuide
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorLabelGuide
    attrClear = clearIndicatorLabelGuide
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.labelGuide"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:labelGuide"
        })
#endif

-- VVV Prop "ordering-index"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@ordering-index@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #orderingIndex 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorOrderingIndex :: (MonadIO m, IsIndicator o) => o -> Word32 -> m ()
setIndicatorOrderingIndex :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Word32 -> m ()
setIndicatorOrderingIndex o
obj Word32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"ordering-index" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@ordering-index@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIndicatorOrderingIndex :: (IsIndicator o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructIndicatorOrderingIndex :: forall o (m :: * -> *).
(IsIndicator o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructIndicatorOrderingIndex Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"ordering-index" Word32
val

#if defined(ENABLE_OVERLOADING)
data IndicatorOrderingIndexPropertyInfo
instance AttrInfo IndicatorOrderingIndexPropertyInfo where
    type AttrAllowedOps IndicatorOrderingIndexPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint IndicatorOrderingIndexPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorOrderingIndexPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint IndicatorOrderingIndexPropertyInfo = (~) Word32
    type AttrTransferType IndicatorOrderingIndexPropertyInfo = Word32
    type AttrGetType IndicatorOrderingIndexPropertyInfo = Word32
    type AttrLabel IndicatorOrderingIndexPropertyInfo = "ordering-index"
    type AttrOrigin IndicatorOrderingIndexPropertyInfo = Indicator
    attrGet = getIndicatorOrderingIndex
    attrSet = setIndicatorOrderingIndex
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorOrderingIndex
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.orderingIndex"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:orderingIndex"
        })
#endif

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

-- | Get the value of the “@status@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #status
-- @
getIndicatorStatus :: (MonadIO m, IsIndicator o) => o -> m (Maybe T.Text)
getIndicatorStatus :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> m (Maybe Text)
getIndicatorStatus 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
"status"

-- | Set the value of the “@status@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #status 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorStatus :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorStatus :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorStatus o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"status" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@status@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #status
-- @
clearIndicatorStatus :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorStatus :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorStatus o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"status" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorStatusPropertyInfo
instance AttrInfo IndicatorStatusPropertyInfo where
    type AttrAllowedOps IndicatorStatusPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorStatusPropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorStatusPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorStatusPropertyInfo = (~) T.Text
    type AttrTransferType IndicatorStatusPropertyInfo = T.Text
    type AttrGetType IndicatorStatusPropertyInfo = (Maybe T.Text)
    type AttrLabel IndicatorStatusPropertyInfo = "status"
    type AttrOrigin IndicatorStatusPropertyInfo = Indicator
    attrGet = getIndicatorStatus
    attrSet = setIndicatorStatus
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorStatus
    attrClear = clearIndicatorStatus
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.status"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:status"
        })
#endif

-- VVV Prop "title"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just True)

-- | Get the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' indicator #title
-- @
getIndicatorTitle :: (MonadIO m, IsIndicator o) => o -> m T.Text
getIndicatorTitle :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m Text
getIndicatorTitle o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getIndicatorTitle" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO 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
"title"

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' indicator [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setIndicatorTitle :: (MonadIO m, IsIndicator o) => o -> T.Text -> m ()
setIndicatorTitle :: forall (m :: * -> *) o.
(MonadIO m, IsIndicator o) =>
o -> Text -> m ()
setIndicatorTitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@title@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearIndicatorTitle :: (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorTitle :: forall (m :: * -> *) o. (MonadIO m, IsIndicator o) => o -> m ()
clearIndicatorTitle o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data IndicatorTitlePropertyInfo
instance AttrInfo IndicatorTitlePropertyInfo where
    type AttrAllowedOps IndicatorTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint IndicatorTitlePropertyInfo = IsIndicator
    type AttrSetTypeConstraint IndicatorTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint IndicatorTitlePropertyInfo = (~) T.Text
    type AttrTransferType IndicatorTitlePropertyInfo = T.Text
    type AttrGetType IndicatorTitlePropertyInfo = T.Text
    type AttrLabel IndicatorTitlePropertyInfo = "title"
    type AttrOrigin IndicatorTitlePropertyInfo = Indicator
    attrGet = getIndicatorTitle
    attrSet = setIndicatorTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructIndicatorTitle
    attrClear = clearIndicatorTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Indicator
type instance O.AttributeList Indicator = IndicatorAttributeList
type IndicatorAttributeList = ('[ '("attentionIconDesc", IndicatorAttentionIconDescPropertyInfo), '("attentionIconName", IndicatorAttentionIconNamePropertyInfo), '("category", IndicatorCategoryPropertyInfo), '("connected", IndicatorConnectedPropertyInfo), '("iconDesc", IndicatorIconDescPropertyInfo), '("iconName", IndicatorIconNamePropertyInfo), '("iconThemePath", IndicatorIconThemePathPropertyInfo), '("id", IndicatorIdPropertyInfo), '("label", IndicatorLabelPropertyInfo), '("labelGuide", IndicatorLabelGuidePropertyInfo), '("orderingIndex", IndicatorOrderingIndexPropertyInfo), '("status", IndicatorStatusPropertyInfo), '("title", IndicatorTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
indicatorAttentionIconDesc :: AttrLabelProxy "attentionIconDesc"
indicatorAttentionIconDesc = AttrLabelProxy

indicatorAttentionIconName :: AttrLabelProxy "attentionIconName"
indicatorAttentionIconName = AttrLabelProxy

indicatorCategory :: AttrLabelProxy "category"
indicatorCategory = AttrLabelProxy

indicatorConnected :: AttrLabelProxy "connected"
indicatorConnected = AttrLabelProxy

indicatorIconDesc :: AttrLabelProxy "iconDesc"
indicatorIconDesc = AttrLabelProxy

indicatorIconName :: AttrLabelProxy "iconName"
indicatorIconName = AttrLabelProxy

indicatorIconThemePath :: AttrLabelProxy "iconThemePath"
indicatorIconThemePath = AttrLabelProxy

indicatorId :: AttrLabelProxy "id"
indicatorId = AttrLabelProxy

indicatorLabel :: AttrLabelProxy "label"
indicatorLabel = AttrLabelProxy

indicatorLabelGuide :: AttrLabelProxy "labelGuide"
indicatorLabelGuide = AttrLabelProxy

indicatorOrderingIndex :: AttrLabelProxy "orderingIndex"
indicatorOrderingIndex = AttrLabelProxy

indicatorStatus :: AttrLabelProxy "status"
indicatorStatus = AttrLabelProxy

indicatorTitle :: AttrLabelProxy "title"
indicatorTitle = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Indicator = IndicatorSignalList
type IndicatorSignalList = ('[ '("connectionChanged", IndicatorConnectionChangedSignalInfo), '("newAttentionIcon", IndicatorNewAttentionIconSignalInfo), '("newIcon", IndicatorNewIconSignalInfo), '("newIconThemePath", IndicatorNewIconThemePathSignalInfo), '("newLabel", IndicatorNewLabelSignalInfo), '("newStatus", IndicatorNewStatusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("scrollEvent", IndicatorScrollEventSignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Indicator::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The unique id of the indicator to create."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon name for this indicator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "AyatanaAppIndicator3" , name = "IndicatorCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The category of indicator."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" })
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_new" app_indicator_new :: 
    CString ->                              -- id : TBasicType TUTF8
    CString ->                              -- icon_name : TBasicType TUTF8
    CUInt ->                                -- category : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "IndicatorCategory"})
    IO (Ptr Indicator)

-- | Creates a new t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' setting the properties:
-- [Indicator:id]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:id") with /@id@/, [Indicator:category]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:category") with /@category@/
-- and [Indicator:iconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconName") with /@iconName@/.
indicatorNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@id@/: The unique id of the indicator to create.
    -> T.Text
    -- ^ /@iconName@/: The icon name for this indicator
    -> AyatanaAppIndicator3.Enums.IndicatorCategory
    -- ^ /@category@/: The category of indicator.
    -> m Indicator
    -- ^ __Returns:__ A pointer to a new t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object.
indicatorNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> IndicatorCategory -> m Indicator
indicatorNew Text
id Text
iconName IndicatorCategory
category = IO Indicator -> m Indicator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Indicator -> m Indicator) -> IO Indicator -> m Indicator
forall a b. (a -> b) -> a -> b
$ do
    CString
id' <- Text -> IO CString
textToCString Text
id
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    let category' :: CUInt
category' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (IndicatorCategory -> Int) -> IndicatorCategory -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndicatorCategory -> Int
forall a. Enum a => a -> Int
fromEnum) IndicatorCategory
category
    Ptr Indicator
result <- CString -> CString -> CUInt -> IO (Ptr Indicator)
app_indicator_new CString
id' CString
iconName' CUInt
category'
    Text -> Ptr Indicator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorNew" Ptr Indicator
result
    Indicator
result' <- ((ManagedPtr Indicator -> Indicator)
-> Ptr Indicator -> IO Indicator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Indicator -> Indicator
Indicator) Ptr Indicator
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    Indicator -> IO Indicator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Indicator
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Indicator::new_with_path
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The unique id of the indicator to create."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon name for this indicator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "AyatanaAppIndicator3" , name = "IndicatorCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The category of indicator."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_theme_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A custom path for finding icons."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" })
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_new_with_path" app_indicator_new_with_path :: 
    CString ->                              -- id : TBasicType TUTF8
    CString ->                              -- icon_name : TBasicType TUTF8
    CUInt ->                                -- category : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "IndicatorCategory"})
    CString ->                              -- icon_theme_path : TBasicType TUTF8
    IO (Ptr Indicator)

-- | Creates a new t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' setting the properties:
-- [Indicator:id]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:id") with /@id@/, [Indicator:category]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:category") with /@category@/,
-- [Indicator:iconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconName") with /@iconName@/ and [Indicator:iconThemePath]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconThemePath")
-- with /@iconThemePath@/.
indicatorNewWithPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@id@/: The unique id of the indicator to create.
    -> T.Text
    -- ^ /@iconName@/: The icon name for this indicator
    -> AyatanaAppIndicator3.Enums.IndicatorCategory
    -- ^ /@category@/: The category of indicator.
    -> T.Text
    -- ^ /@iconThemePath@/: A custom path for finding icons.
    -> m Indicator
    -- ^ __Returns:__ A pointer to a new t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object.
indicatorNewWithPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> IndicatorCategory -> Text -> m Indicator
indicatorNewWithPath Text
id Text
iconName IndicatorCategory
category Text
iconThemePath = IO Indicator -> m Indicator
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Indicator -> m Indicator) -> IO Indicator -> m Indicator
forall a b. (a -> b) -> a -> b
$ do
    CString
id' <- Text -> IO CString
textToCString Text
id
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    let category' :: CUInt
category' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (IndicatorCategory -> Int) -> IndicatorCategory -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndicatorCategory -> Int
forall a. Enum a => a -> Int
fromEnum) IndicatorCategory
category
    CString
iconThemePath' <- Text -> IO CString
textToCString Text
iconThemePath
    Ptr Indicator
result <- CString -> CString -> CUInt -> CString -> IO (Ptr Indicator)
app_indicator_new_with_path CString
id' CString
iconName' CUInt
category' CString
iconThemePath'
    Text -> Ptr Indicator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorNewWithPath" Ptr Indicator
result
    Indicator
result' <- ((ManagedPtr Indicator -> Indicator)
-> Ptr Indicator -> IO Indicator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Indicator -> Indicator
Indicator) Ptr Indicator
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
id'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconThemePath'
    Indicator -> IO Indicator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Indicator
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Indicator::build_menu_from_desktop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desktop_file"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A path to the desktop file to build the menu from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "desktop_profile"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Which entries should be used from the desktop file"
--                 , 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 "app_indicator_build_menu_from_desktop" app_indicator_build_menu_from_desktop :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- desktop_file : TBasicType TUTF8
    CString ->                              -- desktop_profile : TBasicType TUTF8
    IO ()

-- | This function allows for building the Application Indicator menu
-- from a static desktop file.
indicatorBuildMenuFromDesktop ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@desktopFile@/: A path to the desktop file to build the menu from
    -> T.Text
    -- ^ /@desktopProfile@/: Which entries should be used from the desktop file
    -> m ()
indicatorBuildMenuFromDesktop :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> Text -> m ()
indicatorBuildMenuFromDesktop a
self Text
desktopFile Text
desktopProfile = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
desktopFile' <- Text -> IO CString
textToCString Text
desktopFile
    CString
desktopProfile' <- Text -> IO CString
textToCString Text
desktopProfile
    Ptr Indicator -> CString -> CString -> IO ()
app_indicator_build_menu_from_desktop Ptr Indicator
self' CString
desktopFile' CString
desktopProfile'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
desktopFile'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
desktopProfile'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorBuildMenuFromDesktopMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorBuildMenuFromDesktopMethodInfo a signature where
    overloadedMethod = indicatorBuildMenuFromDesktop

instance O.OverloadedMethodInfo IndicatorBuildMenuFromDesktopMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorBuildMenuFromDesktop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorBuildMenuFromDesktop"
        })


#endif

-- method Indicator::get_attention_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_attention_icon" app_indicator_get_attention_icon :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:attentionIconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:attentionIconName").
indicatorGetAttentionIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current attention icon name.
indicatorGetAttentionIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetAttentionIcon a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_attention_icon Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetAttentionIcon" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetAttentionIconMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetAttentionIconMethodInfo a signature where
    overloadedMethod = indicatorGetAttentionIcon

instance O.OverloadedMethodInfo IndicatorGetAttentionIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetAttentionIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetAttentionIcon"
        })


#endif

-- method Indicator::get_attention_icon_desc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_attention_icon_desc" app_indicator_get_attention_icon_desc :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:attentionIconDesc]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:attentionIconDesc").
indicatorGetAttentionIconDesc ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current attention icon description.
indicatorGetAttentionIconDesc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetAttentionIconDesc a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_attention_icon_desc Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetAttentionIconDesc" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetAttentionIconDescMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetAttentionIconDescMethodInfo a signature where
    overloadedMethod = indicatorGetAttentionIconDesc

instance O.OverloadedMethodInfo IndicatorGetAttentionIconDescMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetAttentionIconDesc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetAttentionIconDesc"
        })


#endif

-- method Indicator::get_category
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name
--                    { namespace = "AyatanaAppIndicator3"
--                    , name = "IndicatorCategory"
--                    })
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_category" app_indicator_get_category :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CUInt

-- | Wrapper function for property [Indicator:category]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:category").
indicatorGetCategory ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m AyatanaAppIndicator3.Enums.IndicatorCategory
    -- ^ __Returns:__ The current category.
indicatorGetCategory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m IndicatorCategory
indicatorGetCategory a
self = IO IndicatorCategory -> m IndicatorCategory
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IndicatorCategory -> m IndicatorCategory)
-> IO IndicatorCategory -> m IndicatorCategory
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Indicator -> IO CUInt
app_indicator_get_category Ptr Indicator
self'
    let result' :: IndicatorCategory
result' = (Int -> IndicatorCategory
forall a. Enum a => Int -> a
toEnum (Int -> IndicatorCategory)
-> (CUInt -> Int) -> CUInt -> IndicatorCategory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    IndicatorCategory -> IO IndicatorCategory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IndicatorCategory
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetCategoryMethodInfo
instance (signature ~ (m AyatanaAppIndicator3.Enums.IndicatorCategory), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetCategoryMethodInfo a signature where
    overloadedMethod = indicatorGetCategory

instance O.OverloadedMethodInfo IndicatorGetCategoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetCategory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetCategory"
        })


#endif

-- method Indicator::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_icon" app_indicator_get_icon :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:iconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconName").
indicatorGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current icon name.
indicatorGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetIcon a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_icon Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetIcon" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetIconMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetIconMethodInfo a signature where
    overloadedMethod = indicatorGetIcon

instance O.OverloadedMethodInfo IndicatorGetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetIcon"
        })


#endif

-- method Indicator::get_icon_desc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_icon_desc" app_indicator_get_icon_desc :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:iconDesc]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconDesc").
indicatorGetIconDesc ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current icon description.
indicatorGetIconDesc :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetIconDesc a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_icon_desc Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetIconDesc" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetIconDescMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetIconDescMethodInfo a signature where
    overloadedMethod = indicatorGetIconDesc

instance O.OverloadedMethodInfo IndicatorGetIconDescMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetIconDesc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetIconDesc"
        })


#endif

-- method Indicator::get_icon_theme_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_icon_theme_path" app_indicator_get_icon_theme_path :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:iconThemePath]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconThemePath").
indicatorGetIconThemePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current icon theme path.
indicatorGetIconThemePath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetIconThemePath a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_icon_theme_path Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetIconThemePath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetIconThemePathMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetIconThemePathMethodInfo a signature where
    overloadedMethod = indicatorGetIconThemePath

instance O.OverloadedMethodInfo IndicatorGetIconThemePathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetIconThemePath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetIconThemePath"
        })


#endif

-- method Indicator::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_id" app_indicator_get_id :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:id]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:id").
indicatorGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current ID
indicatorGetId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetId a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_id Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetIdMethodInfo a signature where
    overloadedMethod = indicatorGetId

instance O.OverloadedMethodInfo IndicatorGetIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetId"
        })


#endif

-- method Indicator::get_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_label" app_indicator_get_label :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:label]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:label").
indicatorGetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current label.
indicatorGetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetLabel a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_label Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetLabel" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetLabelMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetLabelMethodInfo a signature where
    overloadedMethod = indicatorGetLabel

instance O.OverloadedMethodInfo IndicatorGetLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetLabel"
        })


#endif

-- method Indicator::get_label_guide
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_label_guide" app_indicator_get_label_guide :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Wrapper function for property [Indicator:labelGuide]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:labelGuide").
indicatorGetLabelGuide ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current label guide.
indicatorGetLabelGuide :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetLabelGuide a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_label_guide Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetLabelGuide" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetLabelGuideMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetLabelGuideMethodInfo a signature where
    overloadedMethod = indicatorGetLabelGuide

instance O.OverloadedMethodInfo IndicatorGetLabelGuideMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetLabelGuide",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetLabelGuide"
        })


#endif

-- method Indicator::get_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Menu" })
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_menu" app_indicator_get_menu :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO (Ptr Gtk.Menu.Menu)

-- | Gets the menu being used for this application indicator.
-- Wrapper function for property t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator':@/menu/@.
indicatorGetMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m Gtk.Menu.Menu
    -- ^ __Returns:__ A t'GI.Gtk.Objects.Menu.Menu' object or 'P.Nothing' if one hasn\'t been set.
indicatorGetMenu :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Menu
indicatorGetMenu a
self = IO Menu -> m Menu
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Menu -> m Menu) -> IO Menu -> m Menu
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Menu
result <- Ptr Indicator -> IO (Ptr Menu)
app_indicator_get_menu Ptr Indicator
self'
    Text -> Ptr Menu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetMenu" Ptr Menu
result
    Menu
result' <- ((ManagedPtr Menu -> Menu) -> Ptr Menu -> IO Menu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Menu -> Menu
Gtk.Menu.Menu) Ptr Menu
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Menu -> IO Menu
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Menu
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetMenuMethodInfo
instance (signature ~ (m Gtk.Menu.Menu), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetMenuMethodInfo a signature where
    overloadedMethod = indicatorGetMenu

instance O.OverloadedMethodInfo IndicatorGetMenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetMenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetMenu"
        })


#endif

-- method Indicator::get_ordering_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_ordering_index" app_indicator_get_ordering_index :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO Word32

-- | Wrapper function for property [Indicator:orderingIndex]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:orderingIndex").
indicatorGetOrderingIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m Word32
    -- ^ __Returns:__ The current ordering index.
indicatorGetOrderingIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Word32
indicatorGetOrderingIndex a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr Indicator -> IO Word32
app_indicator_get_ordering_index Ptr Indicator
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data IndicatorGetOrderingIndexMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetOrderingIndexMethodInfo a signature where
    overloadedMethod = indicatorGetOrderingIndex

instance O.OverloadedMethodInfo IndicatorGetOrderingIndexMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetOrderingIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetOrderingIndex"
        })


#endif

-- method Indicator::get_secondary_activate_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_secondary_activate_target" app_indicator_get_secondary_activate_target :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the menuitem being called on secondary-activate event.
indicatorGetSecondaryActivateTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ A t'GI.Gtk.Objects.Widget.Widget' object or 'P.Nothing' if none has been set.
indicatorGetSecondaryActivateTarget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Widget
indicatorGetSecondaryActivateTarget a
self = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Indicator -> IO (Ptr Widget)
app_indicator_get_secondary_activate_target Ptr Indicator
self'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetSecondaryActivateTarget" Ptr Widget
result
    Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetSecondaryActivateTargetMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetSecondaryActivateTargetMethodInfo a signature where
    overloadedMethod = indicatorGetSecondaryActivateTarget

instance O.OverloadedMethodInfo IndicatorGetSecondaryActivateTargetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetSecondaryActivateTarget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetSecondaryActivateTarget"
        })


#endif

-- method Indicator::get_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name
--                    { namespace = "AyatanaAppIndicator3" , name = "IndicatorStatus" })
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_status" app_indicator_get_status :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CUInt

-- | Wrapper function for property [Indicator:status]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:status").
indicatorGetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m AyatanaAppIndicator3.Enums.IndicatorStatus
    -- ^ __Returns:__ The current status.
indicatorGetStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m IndicatorStatus
indicatorGetStatus a
self = IO IndicatorStatus -> m IndicatorStatus
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IndicatorStatus -> m IndicatorStatus)
-> IO IndicatorStatus -> m IndicatorStatus
forall a b. (a -> b) -> a -> b
$ do
    Ptr Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Indicator -> IO CUInt
app_indicator_get_status Ptr Indicator
self'
    let result' :: IndicatorStatus
result' = (Int -> IndicatorStatus
forall a. Enum a => Int -> a
toEnum (Int -> IndicatorStatus)
-> (CUInt -> Int) -> CUInt -> IndicatorStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    IndicatorStatus -> IO IndicatorStatus
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IndicatorStatus
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetStatusMethodInfo
instance (signature ~ (m AyatanaAppIndicator3.Enums.IndicatorStatus), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetStatusMethodInfo a signature where
    overloadedMethod = indicatorGetStatus

instance O.OverloadedMethodInfo IndicatorGetStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetStatus"
        })


#endif

-- method Indicator::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_get_title" app_indicator_get_title :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    IO CString

-- | Gets the title of the application indicator.  See the function
-- 'GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetTitle' for information on the title.
-- 
-- /Since: 0.5/
indicatorGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> m T.Text
    -- ^ __Returns:__ The current title.
indicatorGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> m Text
indicatorGetTitle a
self = IO Text -> m Text
forall a. IO a -> m a
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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Indicator -> IO CString
app_indicator_get_title Ptr Indicator
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"indicatorGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data IndicatorGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorGetTitleMethodInfo a signature where
    overloadedMethod = indicatorGetTitle

instance O.OverloadedMethodInfo IndicatorGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorGetTitle"
        })


#endif

-- method Indicator::set_attention_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The name of the attention icon to set for this indicator"
--                 , 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 "app_indicator_set_attention_icon" app_indicator_set_attention_icon :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

{-# DEPRECATED indicatorSetAttentionIcon ["Use 'GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetAttentionIconFull' instead."] #-}
-- | Wrapper for 'GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetAttentionIconFull' with a NULL
-- description.
indicatorSetAttentionIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@iconName@/: The name of the attention icon to set for this indicator
    -> m ()
indicatorSetAttentionIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> m ()
indicatorSetAttentionIcon a
self Text
iconName = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr Indicator -> CString -> IO ()
app_indicator_set_attention_icon Ptr Indicator
self' CString
iconName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetAttentionIconMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetAttentionIconMethodInfo a signature where
    overloadedMethod = indicatorSetAttentionIcon

instance O.OverloadedMethodInfo IndicatorSetAttentionIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetAttentionIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetAttentionIcon"
        })


#endif

-- method Indicator::set_attention_icon_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The name of the attention icon to set for this indicator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_desc"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A textual description of the icon"
--                 , 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 "app_indicator_set_attention_icon_full" app_indicator_set_attention_icon_full :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- icon_name : TBasicType TUTF8
    CString ->                              -- icon_desc : TBasicType TUTF8
    IO ()

-- | Wrapper function for property [Indicator:attentionIconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:attentionIconName").
indicatorSetAttentionIconFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@iconName@/: The name of the attention icon to set for this indicator
    -> Maybe (T.Text)
    -- ^ /@iconDesc@/: A textual description of the icon
    -> m ()
indicatorSetAttentionIconFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> Maybe Text -> m ()
indicatorSetAttentionIconFull a
self Text
iconName Maybe Text
iconDesc = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    CString
maybeIconDesc <- case Maybe Text
iconDesc of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jIconDesc -> do
            CString
jIconDesc' <- Text -> IO CString
textToCString Text
jIconDesc
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconDesc'
    Ptr Indicator -> CString -> CString -> IO ()
app_indicator_set_attention_icon_full Ptr Indicator
self' CString
iconName' CString
maybeIconDesc
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconDesc
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetAttentionIconFullMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetAttentionIconFullMethodInfo a signature where
    overloadedMethod = indicatorSetAttentionIconFull

instance O.OverloadedMethodInfo IndicatorSetAttentionIconFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetAttentionIconFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetAttentionIconFull"
        })


#endif

-- method Indicator::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon name to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_set_icon" app_indicator_set_icon :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- icon_name : TBasicType TUTF8
    IO ()

{-# DEPRECATED indicatorSetIcon ["Use 'GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetIconFull'"] #-}
-- | Wrapper function for 'GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetIconFull' with a NULL
-- description.
indicatorSetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@iconName@/: The icon name to set.
    -> m ()
indicatorSetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> m ()
indicatorSetIcon a
self Text
iconName = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    Ptr Indicator -> CString -> IO ()
app_indicator_set_icon Ptr Indicator
self' CString
iconName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetIconMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetIconMethodInfo a signature where
    overloadedMethod = indicatorSetIcon

instance O.OverloadedMethodInfo IndicatorSetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetIcon"
        })


#endif

-- method Indicator::set_icon_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon name to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_desc"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A textual description of the icon for accessibility"
--                 , 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 "app_indicator_set_icon_full" app_indicator_set_icon_full :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- icon_name : TBasicType TUTF8
    CString ->                              -- icon_desc : TBasicType TUTF8
    IO ()

-- | Sets the default icon to use when the status is active but
-- not set to attention.  In most cases, this should be the
-- application icon for the program.
-- 
-- Wrapper function for property [Indicator:iconName]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:iconName") and
-- t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator'::@/icon-desc/@.
indicatorSetIconFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@iconName@/: The icon name to set.
    -> Maybe (T.Text)
    -- ^ /@iconDesc@/: A textual description of the icon for accessibility
    -> m ()
indicatorSetIconFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> Maybe Text -> m ()
indicatorSetIconFull a
self Text
iconName Maybe Text
iconDesc = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconName' <- Text -> IO CString
textToCString Text
iconName
    CString
maybeIconDesc <- case Maybe Text
iconDesc of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jIconDesc -> do
            CString
jIconDesc' <- Text -> IO CString
textToCString Text
jIconDesc
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIconDesc'
    Ptr Indicator -> CString -> CString -> IO ()
app_indicator_set_icon_full Ptr Indicator
self' CString
iconName' CString
maybeIconDesc
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIconDesc
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetIconFullMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetIconFullMethodInfo a signature where
    overloadedMethod = indicatorSetIconFull

instance O.OverloadedMethodInfo IndicatorSetIconFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetIconFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetIconFull"
        })


#endif

-- method Indicator::set_icon_theme_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon_theme_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon theme path to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_set_icon_theme_path" app_indicator_set_icon_theme_path :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- icon_theme_path : TBasicType TUTF8
    IO ()

-- | Sets the path to use when searching for icons.
indicatorSetIconThemePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@iconThemePath@/: The icon theme path to set.
    -> m ()
indicatorSetIconThemePath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> m ()
indicatorSetIconThemePath a
self Text
iconThemePath = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
iconThemePath' <- Text -> IO CString
textToCString Text
iconThemePath
    Ptr Indicator -> CString -> IO ()
app_indicator_set_icon_theme_path Ptr Indicator
self' CString
iconThemePath'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
iconThemePath'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetIconThemePathMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetIconThemePathMethodInfo a signature where
    overloadedMethod = indicatorSetIconThemePath

instance O.OverloadedMethodInfo IndicatorSetIconThemePathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetIconThemePath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetIconThemePath"
        })


#endif

-- method Indicator::set_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The label to show next to the icon."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "guide"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A guide to size the label correctly."
--                 , 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 "app_indicator_set_label" app_indicator_set_label :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- guide : TBasicType TUTF8
    IO ()

-- | This is a wrapper function for the [Indicator:label]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:label") and
-- t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator':@/guide/@ properties.  This function can take @/NULL/@
-- as either /@label@/ or /@guide@/ and will clear the entries.
indicatorSetLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> T.Text
    -- ^ /@label@/: The label to show next to the icon.
    -> T.Text
    -- ^ /@guide@/: A guide to size the label correctly.
    -> m ()
indicatorSetLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Text -> Text -> m ()
indicatorSetLabel a
self Text
label Text
guide = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
label' <- Text -> IO CString
textToCString Text
label
    CString
guide' <- Text -> IO CString
textToCString Text
guide
    Ptr Indicator -> CString -> CString -> IO ()
app_indicator_set_label Ptr Indicator
self' CString
label' CString
guide'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
guide'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetLabelMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetLabelMethodInfo a signature where
    overloadedMethod = indicatorSetLabel

instance O.OverloadedMethodInfo IndicatorSetLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetLabel"
        })


#endif

-- method Indicator::set_menu
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menu"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Menu" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GtkMenu to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "app_indicator_set_menu" app_indicator_set_menu :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    Ptr Gtk.Menu.Menu ->                    -- menu : TInterface (Name {namespace = "Gtk", name = "Menu"})
    IO ()

-- | Sets the menu that should be shown when the Application Indicator
-- is clicked on in the panel.  An application indicator will not
-- be rendered unless it has a menu.
-- 
-- Wrapper function for property t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator':@/menu/@.
indicatorSetMenu ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a, Gtk.Menu.IsMenu b) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator'
    -> Maybe (b)
    -- ^ /@menu@/: A t'GI.Gtk.Objects.Menu.Menu' to set
    -> m ()
indicatorSetMenu :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIndicator a, IsMenu b) =>
a -> Maybe b -> m ()
indicatorSetMenu a
self Maybe b
menu = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Menu
maybeMenu <- case Maybe b
menu of
        Maybe b
Nothing -> Ptr Menu -> IO (Ptr Menu)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Menu
forall a. Ptr a
nullPtr
        Just b
jMenu -> do
            Ptr Menu
jMenu' <- b -> IO (Ptr Menu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMenu
            Ptr Menu -> IO (Ptr Menu)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Menu
jMenu'
    Ptr Indicator -> Ptr Menu -> IO ()
app_indicator_set_menu Ptr Indicator
self' Ptr Menu
maybeMenu
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
menu b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetMenuMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsIndicator a, Gtk.Menu.IsMenu b) => O.OverloadedMethod IndicatorSetMenuMethodInfo a signature where
    overloadedMethod = indicatorSetMenu

instance O.OverloadedMethodInfo IndicatorSetMenuMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetMenu",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetMenu"
        })


#endif

-- method Indicator::set_ordering_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ordering_index"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A value for the ordering of this app indicator"
--                 , 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 "app_indicator_set_ordering_index" app_indicator_set_ordering_index :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    Word32 ->                               -- ordering_index : TBasicType TUInt32
    IO ()

-- | Sets the ordering index for the app indicator which effects the
-- placement of it on the panel.  For almost all app indicator
-- this is not the function you\'re looking for.
-- 
-- Wrapper function for property [Indicator:orderingIndex]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:orderingIndex").
indicatorSetOrderingIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator'
    -> Word32
    -- ^ /@orderingIndex@/: A value for the ordering of this app indicator
    -> m ()
indicatorSetOrderingIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Word32 -> m ()
indicatorSetOrderingIndex a
self Word32
orderingIndex = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Indicator -> Word32 -> IO ()
app_indicator_set_ordering_index Ptr Indicator
self' Word32
orderingIndex
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetOrderingIndexMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetOrderingIndexMethodInfo a signature where
    overloadedMethod = indicatorSetOrderingIndex

instance O.OverloadedMethodInfo IndicatorSetOrderingIndexMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetOrderingIndex",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetOrderingIndex"
        })


#endif

-- method Indicator::set_secondary_activate_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "menuitem"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A #GtkWidget to be activated on secondary activation"
--                 , 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 "app_indicator_set_secondary_activate_target" app_indicator_set_secondary_activate_target :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    Ptr Gtk.Widget.Widget ->                -- menuitem : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO ()

-- | Set the /@menuitem@/ to be activated when a secondary activation event (i.e. a
-- middle-click) is emitted over the t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' icon\/label.
-- 
-- The /@menuitem@/ can be also a complex t'GI.Gtk.Objects.Widget.Widget', but to get activated when
-- a secondary activation occurs in the @/Appindicator/@, it must be a visible and
-- active child (or inner-child) of the t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator':@/menu/@.
-- 
-- Setting /@menuitem@/ to 'P.Nothing' causes to disable this feature.
indicatorSetSecondaryActivateTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator'
    -> Maybe (b)
    -- ^ /@menuitem@/: A t'GI.Gtk.Objects.Widget.Widget' to be activated on secondary activation
    -> m ()
indicatorSetSecondaryActivateTarget :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsIndicator a, IsWidget b) =>
a -> Maybe b -> m ()
indicatorSetSecondaryActivateTarget a
self Maybe b
menuitem = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeMenuitem <- case Maybe b
menuitem of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jMenuitem -> do
            Ptr Widget
jMenuitem' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMenuitem
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jMenuitem'
    Ptr Indicator -> Ptr Widget -> IO ()
app_indicator_set_secondary_activate_target Ptr Indicator
self' Ptr Widget
maybeMenuitem
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
menuitem b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetSecondaryActivateTargetMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsIndicator a, Gtk.Widget.IsWidget b) => O.OverloadedMethod IndicatorSetSecondaryActivateTargetMethodInfo a signature where
    overloadedMethod = indicatorSetSecondaryActivateTarget

instance O.OverloadedMethodInfo IndicatorSetSecondaryActivateTargetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetSecondaryActivateTarget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetSecondaryActivateTarget"
        })


#endif

-- method Indicator::set_status
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator object to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "status"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "AyatanaAppIndicator3" , name = "IndicatorStatus" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The status to set for this indicator"
--                 , 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 "app_indicator_set_status" app_indicator_set_status :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CUInt ->                                -- status : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "IndicatorStatus"})
    IO ()

-- | Wrapper function for property [Indicator:status]("GI.AyatanaAppIndicator3.Objects.Indicator#g:attr:status").
indicatorSetStatus ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator' object to use
    -> AyatanaAppIndicator3.Enums.IndicatorStatus
    -- ^ /@status@/: The status to set for this indicator
    -> m ()
indicatorSetStatus :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> IndicatorStatus -> m ()
indicatorSetStatus a
self IndicatorStatus
status = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let status' :: CUInt
status' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (IndicatorStatus -> Int) -> IndicatorStatus -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndicatorStatus -> Int
forall a. Enum a => a -> Int
fromEnum) IndicatorStatus
status
    Ptr Indicator -> CUInt -> IO ()
app_indicator_set_status Ptr Indicator
self' CUInt
status'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetStatusMethodInfo
instance (signature ~ (AyatanaAppIndicator3.Enums.IndicatorStatus -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetStatusMethodInfo a signature where
    overloadedMethod = indicatorSetStatus

instance O.OverloadedMethodInfo IndicatorSetStatusMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetStatus",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetStatus"
        })


#endif

-- method Indicator::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "AyatanaAppIndicator3" , name = "Indicator" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #AppIndicator" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Title of the app indicator"
--                 , 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 "app_indicator_set_title" app_indicator_set_title :: 
    Ptr Indicator ->                        -- self : TInterface (Name {namespace = "AyatanaAppIndicator3", name = "Indicator"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title of the application indicator, or how it should be referred
-- in a human readable form.  This string should be UTF-8 and localized as it
-- expected that users will set it.
-- 
-- In the Unity desktop the most prominent place that this is show will be
-- in the HUD.  HUD listings for this application indicator will start with
-- the title as the first part of the line for the menu items.
-- 
-- Setting /@title@/ to 'P.Nothing' removes the title.
-- 
-- /Since: 0.5/
indicatorSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsIndicator a) =>
    a
    -- ^ /@self@/: The t'GI.AyatanaAppIndicator3.Objects.Indicator.Indicator'
    -> Maybe (T.Text)
    -- ^ /@title@/: Title of the app indicator
    -> m ()
indicatorSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsIndicator a) =>
a -> Maybe Text -> m ()
indicatorSetTitle a
self Maybe Text
title = 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 Indicator
self' <- a -> IO (Ptr Indicator)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            CString
jTitle' <- Text -> IO CString
textToCString Text
jTitle
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTitle'
    Ptr Indicator -> CString -> IO ()
app_indicator_set_title Ptr Indicator
self' CString
maybeTitle
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTitle
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IndicatorSetTitleMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsIndicator a) => O.OverloadedMethod IndicatorSetTitleMethodInfo a signature where
    overloadedMethod = indicatorSetTitle

instance O.OverloadedMethodInfo IndicatorSetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.AyatanaAppIndicator3.Objects.Indicator.indicatorSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ayatana-appindicator3-0.1.0/docs/GI-AyatanaAppIndicator3-Objects-Indicator.html#v:indicatorSetTitle"
        })


#endif