{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GNotification@ is a mechanism for creating a notification to be shown
-- to the user — typically as a pop-up notification presented by the
-- desktop environment shell.
-- 
-- The key difference between @GNotification@ and other similar APIs is
-- that, if supported by the desktop environment, notifications sent
-- with @GNotification@ will persist after the application has exited,
-- and even across system reboots.
-- 
-- Since the user may click on a notification while the application is
-- not running, applications using @GNotification@ should be able to be
-- started as a D-Bus service, using t'GI.Gio.Objects.Application.Application'.
-- 
-- In order for @GNotification@ to work, the application must have installed
-- a @.desktop@ file. For example:
-- >[Desktop Entry]
-- >Name=Test Application
-- >Comment=Description of what Test Application does
-- >Exec=gnome-test-application
-- >Icon=org.gnome.TestApplication
-- >Terminal=false
-- >Type=Application
-- >Categories=GNOME;GTK;TestApplication Category;
-- >StartupNotify=true
-- >DBusActivatable=true
-- >X-GNOME-UsesNotifications=true
-- 
-- 
-- The @X-GNOME-UsesNotifications@ key indicates to GNOME Control Center
-- that this application uses notifications, so it can be listed in the
-- Control Center’s ‘Notifications’ panel.
-- 
-- The @.desktop@ file must be named as @org.gnome.TestApplication.desktop@,
-- where @org.gnome.TestApplication@ is the ID passed to
-- 'GI.Gio.Objects.Application.applicationNew'.
-- 
-- User interaction with a notification (either the default action, or
-- buttons) must be associated with actions on the application (ie:
-- @app.@ actions).  It is not possible to route user interaction
-- through the notification itself, because the object will not exist if
-- the application is autostarted as a result of a notification being
-- clicked.
-- 
-- A notification can be sent with 'GI.Gio.Objects.Application.applicationSendNotification'.
-- 
-- /Since: 2.40/

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

module GI.Gio.Objects.Notification
    ( 

-- * Exported types
    Notification(..)                        ,
    IsNotification                          ,
    toNotification                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addButton]("GI.Gio.Objects.Notification#g:method:addButton"), [addButtonWithTarget]("GI.Gio.Objects.Notification#g:method:addButtonWithTarget"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setBody]("GI.Gio.Objects.Notification#g:method:setBody"), [setCategory]("GI.Gio.Objects.Notification#g:method:setCategory"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultAction]("GI.Gio.Objects.Notification#g:method:setDefaultAction"), [setDefaultActionAndTarget]("GI.Gio.Objects.Notification#g:method:setDefaultActionAndTarget"), [setIcon]("GI.Gio.Objects.Notification#g:method:setIcon"), [setPriority]("GI.Gio.Objects.Notification#g:method:setPriority"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTitle]("GI.Gio.Objects.Notification#g:method:setTitle"), [setUrgent]("GI.Gio.Objects.Notification#g:method:setUrgent").

#if defined(ENABLE_OVERLOADING)
    ResolveNotificationMethod               ,
#endif

-- ** addButton #method:addButton#

#if defined(ENABLE_OVERLOADING)
    NotificationAddButtonMethodInfo         ,
#endif
    notificationAddButton                   ,


-- ** addButtonWithTarget #method:addButtonWithTarget#

#if defined(ENABLE_OVERLOADING)
    NotificationAddButtonWithTargetMethodInfo,
#endif
    notificationAddButtonWithTarget         ,


-- ** new #method:new#

    notificationNew                         ,


-- ** setBody #method:setBody#

#if defined(ENABLE_OVERLOADING)
    NotificationSetBodyMethodInfo           ,
#endif
    notificationSetBody                     ,


-- ** setCategory #method:setCategory#

#if defined(ENABLE_OVERLOADING)
    NotificationSetCategoryMethodInfo       ,
#endif
    notificationSetCategory                 ,


-- ** setDefaultAction #method:setDefaultAction#

#if defined(ENABLE_OVERLOADING)
    NotificationSetDefaultActionMethodInfo  ,
#endif
    notificationSetDefaultAction            ,


-- ** setDefaultActionAndTarget #method:setDefaultActionAndTarget#

#if defined(ENABLE_OVERLOADING)
    NotificationSetDefaultActionAndTargetMethodInfo,
#endif
    notificationSetDefaultActionAndTarget   ,


-- ** setIcon #method:setIcon#

#if defined(ENABLE_OVERLOADING)
    NotificationSetIconMethodInfo           ,
#endif
    notificationSetIcon                     ,


-- ** setPriority #method:setPriority#

#if defined(ENABLE_OVERLOADING)
    NotificationSetPriorityMethodInfo       ,
#endif
    notificationSetPriority                 ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    NotificationSetTitleMethodInfo          ,
#endif
    notificationSetTitle                    ,


-- ** setUrgent #method:setUrgent#

#if defined(ENABLE_OVERLOADING)
    NotificationSetUrgentMethodInfo         ,
#endif
    notificationSetUrgent                   ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon

#endif

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

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

foreign import ccall "g_notification_get_type"
    c_g_notification_get_type :: IO B.Types.GType

instance B.Types.TypedObject Notification where
    glibType :: IO GType
glibType = IO GType
c_g_notification_get_type

instance B.Types.GObject Notification

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveNotificationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveNotificationMethod "addButton" o = NotificationAddButtonMethodInfo
    ResolveNotificationMethod "addButtonWithTarget" o = NotificationAddButtonWithTargetMethodInfo
    ResolveNotificationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNotificationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNotificationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveNotificationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveNotificationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveNotificationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveNotificationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveNotificationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveNotificationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveNotificationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveNotificationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveNotificationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNotificationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNotificationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNotificationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNotificationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNotificationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNotificationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNotificationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNotificationMethod "setBody" o = NotificationSetBodyMethodInfo
    ResolveNotificationMethod "setCategory" o = NotificationSetCategoryMethodInfo
    ResolveNotificationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNotificationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNotificationMethod "setDefaultAction" o = NotificationSetDefaultActionMethodInfo
    ResolveNotificationMethod "setDefaultActionAndTarget" o = NotificationSetDefaultActionAndTargetMethodInfo
    ResolveNotificationMethod "setIcon" o = NotificationSetIconMethodInfo
    ResolveNotificationMethod "setPriority" o = NotificationSetPriorityMethodInfo
    ResolveNotificationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNotificationMethod "setTitle" o = NotificationSetTitleMethodInfo
    ResolveNotificationMethod "setUrgent" o = NotificationSetUrgentMethodInfo
    ResolveNotificationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method Notification::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the title of the notification"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "Notification" })
-- throws : False
-- Skip return : False

foreign import ccall "g_notification_new" g_notification_new :: 
    CString ->                              -- title : TBasicType TUTF8
    IO (Ptr Notification)

-- | Creates a new t'GI.Gio.Objects.Notification.Notification' with /@title@/ as its title.
-- 
-- After populating /@notification@/ with more details, it can be sent to
-- the desktop shell with 'GI.Gio.Objects.Application.applicationSendNotification'. Changing
-- any properties after this call will not have any effect until
-- resending /@notification@/.
-- 
-- /Since: 2.40/
notificationNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@title@/: the title of the notification
    -> m Notification
    -- ^ __Returns:__ a new t'GI.Gio.Objects.Notification.Notification' instance
notificationNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Notification
notificationNew Text
title = IO Notification -> m Notification
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Notification -> m Notification)
-> IO Notification -> m Notification
forall a b. (a -> b) -> a -> b
$ do
    title' <- Text -> IO CString
textToCString Text
title
    result <- g_notification_new title'
    checkUnexpectedReturnNULL "notificationNew" result
    result' <- (wrapObject Notification) result
    freeMem title'
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Notification::add_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , 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 "label of the button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a detailed action name"
--                 , 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 "g_notification_add_button" g_notification_add_button :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- detailed_action : TBasicType TUTF8
    IO ()

-- | Adds a button to /@notification@/ that activates the action in
-- /@detailedAction@/ when clicked. That action must be an
-- application-wide action (starting with \"app.\"). If /@detailedAction@/
-- contains a target, the action will be activated with that target as
-- its parameter.
-- 
-- See 'GI.Gio.Functions.actionParseDetailedName' for a description of the format
-- for /@detailedAction@/.
-- 
-- /Since: 2.40/
notificationAddButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@label@/: label of the button
    -> T.Text
    -- ^ /@detailedAction@/: a detailed action name
    -> m ()
notificationAddButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Text -> m ()
notificationAddButton a
notification Text
label Text
detailedAction = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    label' <- textToCString label
    detailedAction' <- textToCString detailedAction
    g_notification_add_button notification' label' detailedAction'
    touchManagedPtr notification
    freeMem label'
    freeMem detailedAction'
    return ()

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

instance O.OverloadedMethodInfo NotificationAddButtonMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationAddButton",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationAddButton"
        })


#endif

-- method Notification::add_button_with_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , 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 "label of the button"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an action name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GVariant to use as @action's parameter, or %NULL"
--                 , 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 "g_notification_add_button_with_target_value" g_notification_add_button_with_target_value :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- label : TBasicType TUTF8
    CString ->                              -- action : TBasicType TUTF8
    Ptr GVariant ->                         -- target : TVariant
    IO ()

-- | Adds a button to /@notification@/ that activates /@action@/ when clicked.
-- /@action@/ must be an application-wide action (it must start with \"app.\").
-- 
-- If /@target@/ is non-'P.Nothing', /@action@/ will be activated with /@target@/ as
-- its parameter.
-- 
-- /Since: 2.40/
notificationAddButtonWithTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@label@/: label of the button
    -> T.Text
    -- ^ /@action@/: an action name
    -> Maybe (GVariant)
    -- ^ /@target@/: a t'GVariant' to use as /@action@/\'s parameter, or 'P.Nothing'
    -> m ()
notificationAddButtonWithTarget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Text -> Maybe GVariant -> m ()
notificationAddButtonWithTarget a
notification Text
label Text
action Maybe GVariant
target = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    label' <- textToCString label
    action' <- textToCString action
    maybeTarget <- case target of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jTarget -> do
            jTarget' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jTarget
            return jTarget'
    g_notification_add_button_with_target_value notification' label' action' maybeTarget
    touchManagedPtr notification
    whenJust target touchManagedPtr
    freeMem label'
    freeMem action'
    return ()

#if defined(ENABLE_OVERLOADING)
data NotificationAddButtonWithTargetMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (GVariant) -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationAddButtonWithTargetMethodInfo a signature where
    overloadedMethod = notificationAddButtonWithTarget

instance O.OverloadedMethodInfo NotificationAddButtonWithTargetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationAddButtonWithTarget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationAddButtonWithTarget"
        })


#endif

-- method Notification::set_body
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new body for @notification, or %NULL"
--                 , 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 "g_notification_set_body" g_notification_set_body :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- body : TBasicType TUTF8
    IO ()

-- | Sets the body of /@notification@/ to /@body@/.
-- 
-- /Since: 2.40/
notificationSetBody ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> Maybe (T.Text)
    -- ^ /@body@/: the new body for /@notification@/, or 'P.Nothing'
    -> m ()
notificationSetBody :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Maybe Text -> m ()
notificationSetBody a
notification Maybe Text
body = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    maybeBody <- case body 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
FP.nullPtr
        Just Text
jBody -> do
            jBody' <- Text -> IO CString
textToCString Text
jBody
            return jBody'
    g_notification_set_body notification' maybeBody
    touchManagedPtr notification
    freeMem maybeBody
    return ()

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

instance O.OverloadedMethodInfo NotificationSetBodyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetBody",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetBody"
        })


#endif

-- method Notification::set_category
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the category for @notification, or %NULL for no category"
--                 , 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 "g_notification_set_category" g_notification_set_category :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- category : TBasicType TUTF8
    IO ()

-- | Sets the type of /@notification@/ to /@category@/. Categories have a main
-- type like @email@, @im@ or @device@ and can have a detail separated
-- by a @.@, e.g. @im.received@ or @email.arrived@. Setting the category
-- helps the notification server to select proper feedback to the user.
-- 
-- Standard categories are <https://specifications.freedesktop.org/notification-spec/latest/ar01s06.html listed in the specification>.
-- 
-- /Since: 2.70/
notificationSetCategory ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> Maybe (T.Text)
    -- ^ /@category@/: the category for /@notification@/, or 'P.Nothing' for no category
    -> m ()
notificationSetCategory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Maybe Text -> m ()
notificationSetCategory a
notification Maybe Text
category = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    maybeCategory <- case category 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
FP.nullPtr
        Just Text
jCategory -> do
            jCategory' <- Text -> IO CString
textToCString Text
jCategory
            return jCategory'
    g_notification_set_category notification' maybeCategory
    touchManagedPtr notification
    freeMem maybeCategory
    return ()

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

instance O.OverloadedMethodInfo NotificationSetCategoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetCategory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetCategory"
        })


#endif

-- method Notification::set_default_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a detailed action name"
--                 , 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 "g_notification_set_default_action" g_notification_set_default_action :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- detailed_action : TBasicType TUTF8
    IO ()

-- | Sets the default action of /@notification@/ to /@detailedAction@/. This
-- action is activated when the notification is clicked on.
-- 
-- The action in /@detailedAction@/ must be an application-wide action (it
-- must start with \"app.\"). If /@detailedAction@/ contains a target, the
-- given action will be activated with that target as its parameter.
-- See 'GI.Gio.Functions.actionParseDetailedName' for a description of the format
-- for /@detailedAction@/.
-- 
-- When no default action is set, the application that the notification
-- was sent on is activated.
-- 
-- /Since: 2.40/
notificationSetDefaultAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@detailedAction@/: a detailed action name
    -> m ()
notificationSetDefaultAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> m ()
notificationSetDefaultAction a
notification Text
detailedAction = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    detailedAction' <- textToCString detailedAction
    g_notification_set_default_action notification' detailedAction'
    touchManagedPtr notification
    freeMem detailedAction'
    return ()

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

instance O.OverloadedMethodInfo NotificationSetDefaultActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetDefaultAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetDefaultAction"
        })


#endif

-- method Notification::set_default_action_and_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an action name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GVariant to use as @action's parameter, or %NULL"
--                 , 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 "g_notification_set_default_action_and_target_value" g_notification_set_default_action_and_target_value :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- action : TBasicType TUTF8
    Ptr GVariant ->                         -- target : TVariant
    IO ()

-- | Sets the default action of /@notification@/ to /@action@/. This action is
-- activated when the notification is clicked on. It must be an
-- application-wide action (start with \"app.\").
-- 
-- If /@target@/ is non-'P.Nothing', /@action@/ will be activated with /@target@/ as
-- its parameter. If /@target@/ is floating, it will be consumed.
-- 
-- When no default action is set, the application that the notification
-- was sent on is activated.
-- 
-- /Since: 2.40/
notificationSetDefaultActionAndTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@action@/: an action name
    -> Maybe (GVariant)
    -- ^ /@target@/: a t'GVariant' to use as /@action@/\'s parameter, or 'P.Nothing'
    -> m ()
notificationSetDefaultActionAndTarget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Maybe GVariant -> m ()
notificationSetDefaultActionAndTarget a
notification Text
action Maybe GVariant
target = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    action' <- textToCString action
    maybeTarget <- case target of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jTarget -> do
            jTarget' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jTarget
            return jTarget'
    g_notification_set_default_action_and_target_value notification' action' maybeTarget
    touchManagedPtr notification
    whenJust target touchManagedPtr
    freeMem action'
    return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetDefaultActionAndTargetMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationSetDefaultActionAndTargetMethodInfo a signature where
    overloadedMethod = notificationSetDefaultActionAndTarget

instance O.OverloadedMethodInfo NotificationSetDefaultActionAndTargetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetDefaultActionAndTarget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetDefaultActionAndTarget"
        })


#endif

-- method Notification::set_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TInterface Name { namespace = "Gio" , name = "Icon" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the icon to be shown in @notification, as a #GIcon"
--                 , 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 "g_notification_set_icon" g_notification_set_icon :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    Ptr Gio.Icon.Icon ->                    -- icon : TInterface (Name {namespace = "Gio", name = "Icon"})
    IO ()

-- | Sets the icon of /@notification@/ to /@icon@/.
-- 
-- /Since: 2.40/
notificationSetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a, Gio.Icon.IsIcon b) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> b
    -- ^ /@icon@/: the icon to be shown in /@notification@/, as a t'GI.Gio.Interfaces.Icon.Icon'
    -> m ()
notificationSetIcon :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotification a, IsIcon b) =>
a -> b -> m ()
notificationSetIcon a
notification b
icon = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    icon' <- unsafeManagedPtrCastPtr icon
    g_notification_set_icon notification' icon'
    touchManagedPtr notification
    touchManagedPtr icon
    return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetIconMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsNotification a, Gio.Icon.IsIcon b) => O.OverloadedMethod NotificationSetIconMethodInfo a signature where
    overloadedMethod = notificationSetIcon

instance O.OverloadedMethodInfo NotificationSetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetIcon"
        })


#endif

-- method Notification::set_priority
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "NotificationPriority" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotificationPriority"
--                 , 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 "g_notification_set_priority" g_notification_set_priority :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CUInt ->                                -- priority : TInterface (Name {namespace = "Gio", name = "NotificationPriority"})
    IO ()

-- | Sets the priority of /@notification@/ to /@priority@/. See
-- t'GI.Gio.Enums.NotificationPriority' for possible values.
notificationSetPriority ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> Gio.Enums.NotificationPriority
    -- ^ /@priority@/: a t'GI.Gio.Enums.NotificationPriority'
    -> m ()
notificationSetPriority :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> NotificationPriority -> m ()
notificationSetPriority a
notification NotificationPriority
priority = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    let priority' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (NotificationPriority -> Int) -> NotificationPriority -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NotificationPriority -> Int
forall a. Enum a => a -> Int
fromEnum) NotificationPriority
priority
    g_notification_set_priority notification' priority'
    touchManagedPtr notification
    return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetPriorityMethodInfo
instance (signature ~ (Gio.Enums.NotificationPriority -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationSetPriorityMethodInfo a signature where
    overloadedMethod = notificationSetPriority

instance O.OverloadedMethodInfo NotificationSetPriorityMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetPriority",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetPriority"
        })


#endif

-- method Notification::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new title for @notification"
--                 , 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 "g_notification_set_title" g_notification_set_title :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title of /@notification@/ to /@title@/.
-- 
-- /Since: 2.40/
notificationSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@title@/: the new title for /@notification@/
    -> m ()
notificationSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> m ()
notificationSetTitle a
notification 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    title' <- textToCString title
    g_notification_set_title notification' title'
    touchManagedPtr notification
    freeMem title'
    return ()

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

instance O.OverloadedMethodInfo NotificationSetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetTitle"
        })


#endif

-- method Notification::set_urgent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GNotification" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "urgent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if @notification is urgent"
--                 , 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 "g_notification_set_urgent" g_notification_set_urgent :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Gio", name = "Notification"})
    CInt ->                                 -- urgent : TBasicType TBoolean
    IO ()

{-# DEPRECATED notificationSetUrgent ["(Since version 2.42)","Since 2.42, this has been deprecated in favour of","   'GI.Gio.Objects.Notification.notificationSetPriority'."] #-}
-- | Deprecated in favor of 'GI.Gio.Objects.Notification.notificationSetPriority'.
-- 
-- /Since: 2.40/
notificationSetUrgent ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Gio.Objects.Notification.Notification'
    -> Bool
    -- ^ /@urgent@/: 'P.True' if /@notification@/ is urgent
    -> m ()
notificationSetUrgent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Bool -> m ()
notificationSetUrgent a
notification Bool
urgent = 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
    notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    let urgent' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
urgent
    g_notification_set_urgent notification' urgent'
    touchManagedPtr notification
    return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetUrgentMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationSetUrgentMethodInfo a signature where
    overloadedMethod = notificationSetUrgent

instance O.OverloadedMethodInfo NotificationSetUrgentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Notification.notificationSetUrgent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Notification.html#v:notificationSetUrgent"
        })


#endif