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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A passive pop-up notification.

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

module GI.Notify.Objects.Notification
    ( 

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


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addAction]("GI.Notify.Objects.Notification#g:method:addAction"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearActions]("GI.Notify.Objects.Notification#g:method:clearActions"), [clearHints]("GI.Notify.Objects.Notification#g:method:clearHints"), [close]("GI.Notify.Objects.Notification#g:method:close"), [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"), [show]("GI.Notify.Objects.Notification#g:method:show"), [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"), [update]("GI.Notify.Objects.Notification#g:method:update"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActivationToken]("GI.Notify.Objects.Notification#g:method:getActivationToken"), [getClosedReason]("GI.Notify.Objects.Notification#g:method:getClosedReason"), [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
-- [setAppName]("GI.Notify.Objects.Notification#g:method:setAppName"), [setCategory]("GI.Notify.Objects.Notification#g:method:setCategory"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setHint]("GI.Notify.Objects.Notification#g:method:setHint"), [setHintByte]("GI.Notify.Objects.Notification#g:method:setHintByte"), [setHintByteArray]("GI.Notify.Objects.Notification#g:method:setHintByteArray"), [setHintDouble]("GI.Notify.Objects.Notification#g:method:setHintDouble"), [setHintInt32]("GI.Notify.Objects.Notification#g:method:setHintInt32"), [setHintString]("GI.Notify.Objects.Notification#g:method:setHintString"), [setHintUint32]("GI.Notify.Objects.Notification#g:method:setHintUint32"), [setIconFromPixbuf]("GI.Notify.Objects.Notification#g:method:setIconFromPixbuf"), [setImageFromPixbuf]("GI.Notify.Objects.Notification#g:method:setImageFromPixbuf"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTimeout]("GI.Notify.Objects.Notification#g:method:setTimeout"), [setUrgency]("GI.Notify.Objects.Notification#g:method:setUrgency").

#if defined(ENABLE_OVERLOADING)
    ResolveNotificationMethod               ,
#endif

-- ** addAction #method:addAction#

#if defined(ENABLE_OVERLOADING)
    NotificationAddActionMethodInfo         ,
#endif
    notificationAddAction                   ,


-- ** clearActions #method:clearActions#

#if defined(ENABLE_OVERLOADING)
    NotificationClearActionsMethodInfo      ,
#endif
    notificationClearActions                ,


-- ** clearHints #method:clearHints#

#if defined(ENABLE_OVERLOADING)
    NotificationClearHintsMethodInfo        ,
#endif
    notificationClearHints                  ,


-- ** close #method:close#

#if defined(ENABLE_OVERLOADING)
    NotificationCloseMethodInfo             ,
#endif
    notificationClose                       ,


-- ** getActivationToken #method:getActivationToken#

#if defined(ENABLE_OVERLOADING)
    NotificationGetActivationTokenMethodInfo,
#endif
    notificationGetActivationToken          ,


-- ** getClosedReason #method:getClosedReason#

#if defined(ENABLE_OVERLOADING)
    NotificationGetClosedReasonMethodInfo   ,
#endif
    notificationGetClosedReason             ,


-- ** new #method:new#

    notificationNew                         ,


-- ** setAppName #method:setAppName#

#if defined(ENABLE_OVERLOADING)
    NotificationSetAppNameMethodInfo        ,
#endif
    notificationSetAppName                  ,


-- ** setCategory #method:setCategory#

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


-- ** setHint #method:setHint#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintMethodInfo           ,
#endif
    notificationSetHint                     ,


-- ** setHintByte #method:setHintByte#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintByteMethodInfo       ,
#endif
    notificationSetHintByte                 ,


-- ** setHintByteArray #method:setHintByteArray#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintByteArrayMethodInfo  ,
#endif
    notificationSetHintByteArray            ,


-- ** setHintDouble #method:setHintDouble#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintDoubleMethodInfo     ,
#endif
    notificationSetHintDouble               ,


-- ** setHintInt32 #method:setHintInt32#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintInt32MethodInfo      ,
#endif
    notificationSetHintInt32                ,


-- ** setHintString #method:setHintString#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintStringMethodInfo     ,
#endif
    notificationSetHintString               ,


-- ** setHintUint32 #method:setHintUint32#

#if defined(ENABLE_OVERLOADING)
    NotificationSetHintUint32MethodInfo     ,
#endif
    notificationSetHintUint32               ,


-- ** setIconFromPixbuf #method:setIconFromPixbuf#

#if defined(ENABLE_OVERLOADING)
    NotificationSetIconFromPixbufMethodInfo ,
#endif
    notificationSetIconFromPixbuf           ,


-- ** setImageFromPixbuf #method:setImageFromPixbuf#

#if defined(ENABLE_OVERLOADING)
    NotificationSetImageFromPixbufMethodInfo,
#endif
    notificationSetImageFromPixbuf          ,


-- ** setTimeout #method:setTimeout#

#if defined(ENABLE_OVERLOADING)
    NotificationSetTimeoutMethodInfo        ,
#endif
    notificationSetTimeout                  ,


-- ** setUrgency #method:setUrgency#

#if defined(ENABLE_OVERLOADING)
    NotificationSetUrgencyMethodInfo        ,
#endif
    notificationSetUrgency                  ,


-- ** show #method:show#

#if defined(ENABLE_OVERLOADING)
    NotificationShowMethodInfo              ,
#endif
    notificationShow                        ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    NotificationUpdateMethodInfo            ,
#endif
    notificationUpdate                      ,




 -- * Properties


-- ** appName #attr:appName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NotificationAppNamePropertyInfo         ,
#endif
    constructNotificationAppName            ,
    getNotificationAppName                  ,
#if defined(ENABLE_OVERLOADING)
    notificationAppName                     ,
#endif
    setNotificationAppName                  ,


-- ** body #attr:body#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NotificationBodyPropertyInfo            ,
#endif
    clearNotificationBody                   ,
    constructNotificationBody               ,
    getNotificationBody                     ,
#if defined(ENABLE_OVERLOADING)
    notificationBody                        ,
#endif
    setNotificationBody                     ,


-- ** closedReason #attr:closedReason#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NotificationClosedReasonPropertyInfo    ,
#endif
    getNotificationClosedReason             ,
#if defined(ENABLE_OVERLOADING)
    notificationClosedReason                ,
#endif


-- ** iconName #attr:iconName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NotificationIconNamePropertyInfo        ,
#endif
    clearNotificationIconName               ,
    constructNotificationIconName           ,
    getNotificationIconName                 ,
#if defined(ENABLE_OVERLOADING)
    notificationIconName                    ,
#endif
    setNotificationIconName                 ,


-- ** id #attr:id#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NotificationIdPropertyInfo              ,
#endif
    constructNotificationId                 ,
    getNotificationId                       ,
#if defined(ENABLE_OVERLOADING)
    notificationId                          ,
#endif
    setNotificationId                       ,


-- ** summary #attr:summary#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    NotificationSummaryPropertyInfo         ,
#endif
    clearNotificationSummary                ,
    constructNotificationSummary            ,
    getNotificationSummary                  ,
#if defined(ENABLE_OVERLOADING)
    notificationSummary                     ,
#endif
    setNotificationSummary                  ,




 -- * Signals


-- ** closed #signal:closed#

    NotificationClosedCallback              ,
#if defined(ENABLE_OVERLOADING)
    NotificationClosedSignalInfo            ,
#endif
    afterNotificationClosed                 ,
    onNotificationClosed                    ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Notify.Callbacks as Notify.Callbacks
import {-# SOURCE #-} qualified GI.Notify.Enums as Notify.Enums

-- | 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 "notify_notification_get_type"
    c_notify_notification_get_type :: IO B.Types.GType

instance B.Types.TypedObject Notification where
    glibType :: IO GType
glibType = IO GType
c_notify_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_notify_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 Notification
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 Notification
ptr Ptr Notification -> Ptr Notification -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Notification
forall a. Ptr a
FP.nullPtr
        then Notification -> Maybe Notification
forall a. a -> Maybe a
P.Just (Notification -> Maybe Notification)
-> IO Notification -> IO (Maybe Notification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Notification -> Notification)
-> Ptr Notification -> IO Notification
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Notification -> Notification
Notification Ptr Notification
ptr
        else Maybe Notification -> IO (Maybe Notification)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Notification
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveNotificationMethod (t :: Symbol) (o :: *) :: * where
    ResolveNotificationMethod "addAction" o = NotificationAddActionMethodInfo
    ResolveNotificationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNotificationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNotificationMethod "clearActions" o = NotificationClearActionsMethodInfo
    ResolveNotificationMethod "clearHints" o = NotificationClearHintsMethodInfo
    ResolveNotificationMethod "close" o = NotificationCloseMethodInfo
    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 "show" o = NotificationShowMethodInfo
    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 "update" o = NotificationUpdateMethodInfo
    ResolveNotificationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNotificationMethod "getActivationToken" o = NotificationGetActivationTokenMethodInfo
    ResolveNotificationMethod "getClosedReason" o = NotificationGetClosedReasonMethodInfo
    ResolveNotificationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNotificationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNotificationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNotificationMethod "setAppName" o = NotificationSetAppNameMethodInfo
    ResolveNotificationMethod "setCategory" o = NotificationSetCategoryMethodInfo
    ResolveNotificationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNotificationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNotificationMethod "setHint" o = NotificationSetHintMethodInfo
    ResolveNotificationMethod "setHintByte" o = NotificationSetHintByteMethodInfo
    ResolveNotificationMethod "setHintByteArray" o = NotificationSetHintByteArrayMethodInfo
    ResolveNotificationMethod "setHintDouble" o = NotificationSetHintDoubleMethodInfo
    ResolveNotificationMethod "setHintInt32" o = NotificationSetHintInt32MethodInfo
    ResolveNotificationMethod "setHintString" o = NotificationSetHintStringMethodInfo
    ResolveNotificationMethod "setHintUint32" o = NotificationSetHintUint32MethodInfo
    ResolveNotificationMethod "setIconFromPixbuf" o = NotificationSetIconFromPixbufMethodInfo
    ResolveNotificationMethod "setImageFromPixbuf" o = NotificationSetImageFromPixbufMethodInfo
    ResolveNotificationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNotificationMethod "setTimeout" o = NotificationSetTimeoutMethodInfo
    ResolveNotificationMethod "setUrgency" o = NotificationSetUrgencyMethodInfo
    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

-- signal Notification::closed
-- | Emitted when the notification is closed.
type NotificationClosedCallback =
    IO ()

type C_NotificationClosedCallback =
    Ptr Notification ->                     -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_NotificationClosedCallback :: 
    GObject a => (a -> NotificationClosedCallback) ->
    C_NotificationClosedCallback
wrap_NotificationClosedCallback :: forall a. GObject a => (a -> IO ()) -> C_NotificationClosedCallback
wrap_NotificationClosedCallback a -> IO ()
gi'cb Ptr Notification
gi'selfPtr Ptr ()
_ = do
    Ptr Notification -> (Notification -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Notification
gi'selfPtr ((Notification -> IO ()) -> IO ())
-> (Notification -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Notification
gi'self -> a -> IO ()
gi'cb (Notification -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Notification
gi'self) 


-- | Connect a signal handler for the [closed](#signal:closed) 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' notification #closed callback
-- @
-- 
-- 
onNotificationClosed :: (IsNotification a, MonadIO m) => a -> ((?self :: a) => NotificationClosedCallback) -> m SignalHandlerId
onNotificationClosed :: forall a (m :: * -> *).
(IsNotification a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onNotificationClosed 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_NotificationClosedCallback
wrapped' = (a -> IO ()) -> C_NotificationClosedCallback
forall a. GObject a => (a -> IO ()) -> C_NotificationClosedCallback
wrap_NotificationClosedCallback a -> IO ()
wrapped
    FunPtr C_NotificationClosedCallback
wrapped'' <- C_NotificationClosedCallback
-> IO (FunPtr C_NotificationClosedCallback)
mk_NotificationClosedCallback C_NotificationClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_NotificationClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closed" FunPtr C_NotificationClosedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [closed](#signal:closed) 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' notification #closed 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.
-- 
afterNotificationClosed :: (IsNotification a, MonadIO m) => a -> ((?self :: a) => NotificationClosedCallback) -> m SignalHandlerId
afterNotificationClosed :: forall a (m :: * -> *).
(IsNotification a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterNotificationClosed 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_NotificationClosedCallback
wrapped' = (a -> IO ()) -> C_NotificationClosedCallback
forall a. GObject a => (a -> IO ()) -> C_NotificationClosedCallback
wrap_NotificationClosedCallback a -> IO ()
wrapped
    FunPtr C_NotificationClosedCallback
wrapped'' <- C_NotificationClosedCallback
-> IO (FunPtr C_NotificationClosedCallback)
mk_NotificationClosedCallback C_NotificationClosedCallback
wrapped'
    a
-> Text
-> FunPtr C_NotificationClosedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"closed" FunPtr C_NotificationClosedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data NotificationClosedSignalInfo
instance SignalInfo NotificationClosedSignalInfo where
    type HaskellCallbackType NotificationClosedSignalInfo = NotificationClosedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_NotificationClosedCallback cb
        cb'' <- mk_NotificationClosedCallback cb'
        connectSignalFunPtr obj "closed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification::closed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:signal:closed"})

#endif

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

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

-- | Set the value of the “@app-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notification [ #appName 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotificationAppName :: (MonadIO m, IsNotification o) => o -> T.Text -> m ()
setNotificationAppName :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> Text -> m ()
setNotificationAppName 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
"app-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data NotificationAppNamePropertyInfo
instance AttrInfo NotificationAppNamePropertyInfo where
    type AttrAllowedOps NotificationAppNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotificationAppNamePropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationAppNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NotificationAppNamePropertyInfo = (~) T.Text
    type AttrTransferType NotificationAppNamePropertyInfo = T.Text
    type AttrGetType NotificationAppNamePropertyInfo = (Maybe T.Text)
    type AttrLabel NotificationAppNamePropertyInfo = "app-name"
    type AttrOrigin NotificationAppNamePropertyInfo = Notification
    attrGet = getNotificationAppName
    attrSet = setNotificationAppName
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotificationAppName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.appName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:attr:appName"
        })
#endif

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

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

-- | Set the value of the “@body@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notification [ #body 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotificationBody :: (MonadIO m, IsNotification o) => o -> T.Text -> m ()
setNotificationBody :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> Text -> m ()
setNotificationBody 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
"body" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@body@” 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' #body
-- @
clearNotificationBody :: (MonadIO m, IsNotification o) => o -> m ()
clearNotificationBody :: forall (m :: * -> *) o. (MonadIO m, IsNotification o) => o -> m ()
clearNotificationBody 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
"body" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data NotificationBodyPropertyInfo
instance AttrInfo NotificationBodyPropertyInfo where
    type AttrAllowedOps NotificationBodyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotificationBodyPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationBodyPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NotificationBodyPropertyInfo = (~) T.Text
    type AttrTransferType NotificationBodyPropertyInfo = T.Text
    type AttrGetType NotificationBodyPropertyInfo = (Maybe T.Text)
    type AttrLabel NotificationBodyPropertyInfo = "body"
    type AttrOrigin NotificationBodyPropertyInfo = Notification
    attrGet = getNotificationBody
    attrSet = setNotificationBody
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotificationBody
    attrClear = clearNotificationBody
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.body"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:attr:body"
        })
#endif

-- VVV Prop "closed-reason"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@closed-reason@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' notification #closedReason
-- @
getNotificationClosedReason :: (MonadIO m, IsNotification o) => o -> m Int32
getNotificationClosedReason :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> m Int32
getNotificationClosedReason o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"closed-reason"

#if defined(ENABLE_OVERLOADING)
data NotificationClosedReasonPropertyInfo
instance AttrInfo NotificationClosedReasonPropertyInfo where
    type AttrAllowedOps NotificationClosedReasonPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint NotificationClosedReasonPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationClosedReasonPropertyInfo = (~) ()
    type AttrTransferTypeConstraint NotificationClosedReasonPropertyInfo = (~) ()
    type AttrTransferType NotificationClosedReasonPropertyInfo = ()
    type AttrGetType NotificationClosedReasonPropertyInfo = Int32
    type AttrLabel NotificationClosedReasonPropertyInfo = "closed-reason"
    type AttrOrigin NotificationClosedReasonPropertyInfo = Notification
    attrGet = getNotificationClosedReason
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.closedReason"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:attr:closedReason"
        })
#endif

-- VVV Prop "icon-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- 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' notification #iconName
-- @
getNotificationIconName :: (MonadIO m, IsNotification o) => o -> m (Maybe T.Text)
getNotificationIconName :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> m (Maybe Text)
getNotificationIconName 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' notification [ #iconName 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotificationIconName :: (MonadIO m, IsNotification o) => o -> T.Text -> m ()
setNotificationIconName :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> Text -> m ()
setNotificationIconName 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`.
constructNotificationIconName :: (IsNotification o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructNotificationIconName :: forall o (m :: * -> *).
(IsNotification o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructNotificationIconName 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
-- @
clearNotificationIconName :: (MonadIO m, IsNotification o) => o -> m ()
clearNotificationIconName :: forall (m :: * -> *) o. (MonadIO m, IsNotification o) => o -> m ()
clearNotificationIconName 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 NotificationIconNamePropertyInfo
instance AttrInfo NotificationIconNamePropertyInfo where
    type AttrAllowedOps NotificationIconNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotificationIconNamePropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationIconNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NotificationIconNamePropertyInfo = (~) T.Text
    type AttrTransferType NotificationIconNamePropertyInfo = T.Text
    type AttrGetType NotificationIconNamePropertyInfo = (Maybe T.Text)
    type AttrLabel NotificationIconNamePropertyInfo = "icon-name"
    type AttrOrigin NotificationIconNamePropertyInfo = Notification
    attrGet = getNotificationIconName
    attrSet = setNotificationIconName
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotificationIconName
    attrClear = clearNotificationIconName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.iconName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:attr:iconName"
        })
#endif

-- VVV Prop "id"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Nothing,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' notification #id
-- @
getNotificationId :: (MonadIO m, IsNotification o) => o -> m Int32
getNotificationId :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> m Int32
getNotificationId o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"id"

-- | Set 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.set' notification [ #id 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotificationId :: (MonadIO m, IsNotification o) => o -> Int32 -> m ()
setNotificationId :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> Int32 -> m ()
setNotificationId o
obj Int32
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 -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"id" Int32
val

-- | 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`.
constructNotificationId :: (IsNotification o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructNotificationId :: forall o (m :: * -> *).
(IsNotification o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructNotificationId Int32
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 -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"id" Int32
val

#if defined(ENABLE_OVERLOADING)
data NotificationIdPropertyInfo
instance AttrInfo NotificationIdPropertyInfo where
    type AttrAllowedOps NotificationIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint NotificationIdPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationIdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint NotificationIdPropertyInfo = (~) Int32
    type AttrTransferType NotificationIdPropertyInfo = Int32
    type AttrGetType NotificationIdPropertyInfo = Int32
    type AttrLabel NotificationIdPropertyInfo = "id"
    type AttrOrigin NotificationIdPropertyInfo = Notification
    attrGet = getNotificationId
    attrSet = setNotificationId
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotificationId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.id"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:attr:id"
        })
#endif

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

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

-- | Set the value of the “@summary@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' notification [ #summary 'Data.GI.Base.Attributes.:=' value ]
-- @
setNotificationSummary :: (MonadIO m, IsNotification o) => o -> T.Text -> m ()
setNotificationSummary :: forall (m :: * -> *) o.
(MonadIO m, IsNotification o) =>
o -> Text -> m ()
setNotificationSummary 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
"summary" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@summary@” 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' #summary
-- @
clearNotificationSummary :: (MonadIO m, IsNotification o) => o -> m ()
clearNotificationSummary :: forall (m :: * -> *) o. (MonadIO m, IsNotification o) => o -> m ()
clearNotificationSummary 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
"summary" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data NotificationSummaryPropertyInfo
instance AttrInfo NotificationSummaryPropertyInfo where
    type AttrAllowedOps NotificationSummaryPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotificationSummaryPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationSummaryPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint NotificationSummaryPropertyInfo = (~) T.Text
    type AttrTransferType NotificationSummaryPropertyInfo = T.Text
    type AttrGetType NotificationSummaryPropertyInfo = (Maybe T.Text)
    type AttrLabel NotificationSummaryPropertyInfo = "summary"
    type AttrOrigin NotificationSummaryPropertyInfo = Notification
    attrGet = getNotificationSummary
    attrSet = setNotificationSummary
    attrTransfer _ v = do
        return v
    attrConstruct = constructNotificationSummary
    attrClear = clearNotificationSummary
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.summary"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#g:attr:summary"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Notification
type instance O.AttributeList Notification = NotificationAttributeList
type NotificationAttributeList = ('[ '("appName", NotificationAppNamePropertyInfo), '("body", NotificationBodyPropertyInfo), '("closedReason", NotificationClosedReasonPropertyInfo), '("iconName", NotificationIconNamePropertyInfo), '("id", NotificationIdPropertyInfo), '("summary", NotificationSummaryPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
notificationAppName :: AttrLabelProxy "appName"
notificationAppName = AttrLabelProxy

notificationBody :: AttrLabelProxy "body"
notificationBody = AttrLabelProxy

notificationClosedReason :: AttrLabelProxy "closedReason"
notificationClosedReason = AttrLabelProxy

notificationIconName :: AttrLabelProxy "iconName"
notificationIconName = AttrLabelProxy

notificationId :: AttrLabelProxy "id"
notificationId = AttrLabelProxy

notificationSummary :: AttrLabelProxy "summary"
notificationSummary = AttrLabelProxy

#endif

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

#endif

-- method Notification::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "summary"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The required summary text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The optional body text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The optional icon theme icon name or filename."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Notify" , name = "Notification" })
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_new" notify_notification_new :: 
    CString ->                              -- summary : TBasicType TUTF8
    CString ->                              -- body : TBasicType TUTF8
    CString ->                              -- icon : TBasicType TUTF8
    IO (Ptr Notification)

-- | Creates a new t'GI.Notify.Objects.Notification.Notification'. The summary text is required, but
-- all other parameters are optional.
notificationNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@summary@/: The required summary text.
    -> Maybe (T.Text)
    -- ^ /@body@/: The optional body text.
    -> Maybe (T.Text)
    -- ^ /@icon@/: The optional icon theme icon name or filename.
    -> m Notification
    -- ^ __Returns:__ The new t'GI.Notify.Objects.Notification.Notification'.
notificationNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe Text -> Maybe Text -> m Notification
notificationNew Text
summary Maybe Text
body Maybe Text
icon = 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
    CString
summary' <- Text -> IO CString
textToCString Text
summary
    CString
maybeBody <- case Maybe Text
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
nullPtr
        Just Text
jBody -> do
            CString
jBody' <- Text -> IO CString
textToCString Text
jBody
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jBody'
    CString
maybeIcon <- case Maybe Text
icon 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
jIcon -> do
            CString
jIcon' <- Text -> IO CString
textToCString Text
jIcon
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIcon'
    Ptr Notification
result <- CString -> CString -> CString -> IO (Ptr Notification)
notify_notification_new CString
summary' CString
maybeBody CString
maybeIcon
    Text -> Ptr Notification -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"notificationNew" Ptr Notification
result
    Notification
result' <- ((ManagedPtr Notification -> Notification)
-> Ptr Notification -> IO Notification
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Notification -> Notification
Notification) Ptr Notification
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
summary'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIcon
    Notification -> IO Notification
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Notification
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Notification::add_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The action ID." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The human-readable action label."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "ActionCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The action's callback function."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 4
--           , argDestroy = 5
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional custom data to pass to @callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "free_func"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "An optional function to free @user_data when the notification\n            is destroyed."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_add_action" notify_notification_add_action :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- action : TBasicType TUTF8
    CString ->                              -- label : TBasicType TUTF8
    FunPtr Notify.Callbacks.C_ActionCallback -> -- callback : TInterface (Name {namespace = "Notify", name = "ActionCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- free_func : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Adds an action to a notification. When the action is invoked, the
-- specified callback function will be called, along with the value passed
-- to /@userData@/.
notificationAddAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@action@/: The action ID.
    -> T.Text
    -- ^ /@label@/: The human-readable action label.
    -> Notify.Callbacks.ActionCallback
    -- ^ /@callback@/: The action\'s callback function.
    -> m ()
notificationAddAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Text -> ActionCallback -> m ()
notificationAddAction a
notification Text
action Text
label ActionCallback
callback = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
action' <- Text -> IO CString
textToCString Text
action
    CString
label' <- Text -> IO CString
textToCString Text
label
    FunPtr C_ActionCallback
callback' <- C_ActionCallback -> IO (FunPtr C_ActionCallback)
Notify.Callbacks.mk_ActionCallback (Maybe (Ptr (FunPtr C_ActionCallback))
-> ActionCallback_WithClosures -> C_ActionCallback
Notify.Callbacks.wrap_ActionCallback Maybe (Ptr (FunPtr C_ActionCallback))
forall a. Maybe a
Nothing (ActionCallback -> ActionCallback_WithClosures
Notify.Callbacks.drop_closures_ActionCallback ActionCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_ActionCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ActionCallback
callback'
    let freeFunc :: FunPtr (Ptr a -> IO ())
freeFunc = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Notification
-> CString
-> CString
-> FunPtr C_ActionCallback
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
notify_notification_add_action Ptr Notification
notification' CString
action' CString
label' FunPtr C_ActionCallback
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
freeFunc
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
action'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
label'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationAddActionMethodInfo
instance (signature ~ (T.Text -> T.Text -> Notify.Callbacks.ActionCallback -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationAddActionMethodInfo a signature where
    overloadedMethod = notificationAddAction

instance O.OverloadedMethodInfo NotificationAddActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationAddAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationAddAction"
        })


#endif

-- method Notification::clear_actions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_clear_actions" notify_notification_clear_actions :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    IO ()

-- | Clears all actions from the notification.
notificationClearActions ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> m ()
notificationClearActions :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> m ()
notificationClearActions a
notification = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Notification -> IO ()
notify_notification_clear_actions Ptr Notification
notification'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationClearActionsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationClearActionsMethodInfo a signature where
    overloadedMethod = notificationClearActions

instance O.OverloadedMethodInfo NotificationClearActionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationClearActions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationClearActions"
        })


#endif

-- method Notification::clear_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_clear_hints" notify_notification_clear_hints :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    IO ()

-- | Clears all hints from the notification.
notificationClearHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> m ()
notificationClearHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> m ()
notificationClearHints a
notification = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Notification -> IO ()
notify_notification_clear_hints Ptr Notification
notification'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationClearHintsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationClearHintsMethodInfo a signature where
    overloadedMethod = notificationClearHints

instance O.OverloadedMethodInfo NotificationClearHintsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationClearHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationClearHints"
        })


#endif

-- method Notification::close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "notify_notification_close" notify_notification_close :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Synchronously tells the notification server to hide the notification on the screen.
notificationClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
notificationClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> m ()
notificationClose a
notification = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Notification -> Ptr (Ptr GError) -> IO CInt
notify_notification_close Ptr Notification
notification'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data NotificationCloseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationCloseMethodInfo a signature where
    overloadedMethod = notificationClose

instance O.OverloadedMethodInfo NotificationCloseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationClose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationClose"
        })


#endif

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

foreign import ccall "notify_notification_get_activation_token" notify_notification_get_activation_token :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    IO CString

-- | If an an action is currently being activated, return the activation token.
-- This function is intended to be used in a t'GI.Notify.Callbacks.ActionCallback' to get
-- the activation token for the activated action, if the notification daemon
-- supports it.
-- 
-- /Since: 0.7.10/
notificationGetActivationToken ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> m T.Text
    -- ^ __Returns:__ The current activation token, or 'P.Nothing' if none
notificationGetActivationToken :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> m Text
notificationGetActivationToken a
notification = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
result <- Ptr Notification -> IO CString
notify_notification_get_activation_token Ptr Notification
notification'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"notificationGetActivationToken" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

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

instance O.OverloadedMethodInfo NotificationGetActivationTokenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationGetActivationToken",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationGetActivationToken"
        })


#endif

-- method Notification::get_closed_reason
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_get_closed_reason" notify_notification_get_closed_reason :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    IO Int32

-- | Returns the closed reason code for the notification. This is valid only
-- after the \"closed\" signal is emitted.
-- 
-- Since version 0.8.0 the returned value is of type t'GI.Notify.Enums.ClosedReason'.
notificationGetClosedReason ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> m Int32
    -- ^ __Returns:__ An integer representing the closed reason code
    --  (Since 0.8.0 it\'s also a t'GI.Notify.Enums.ClosedReason').
notificationGetClosedReason :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> m Int32
notificationGetClosedReason a
notification = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Int32
result <- Ptr Notification -> IO Int32
notify_notification_get_closed_reason Ptr Notification
notification'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data NotificationGetClosedReasonMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationGetClosedReasonMethodInfo a signature where
    overloadedMethod = notificationGetClosedReason

instance O.OverloadedMethodInfo NotificationGetClosedReasonMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationGetClosedReason",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationGetClosedReason"
        })


#endif

-- method Notification::set_app_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NotifyNotification"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "app_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the localised application name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_app_name" notify_notification_set_app_name :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- app_name : TBasicType TUTF8
    IO ()

-- | Sets the application name for the notification. If this function is
-- not called or if /@appName@/ is 'P.Nothing', the application name will be
-- set from the value used in 'GI.Notify.Functions.init' or overridden with
-- 'GI.Notify.Functions.setAppName'.
-- 
-- /Since: 0.7.3/
notificationSetAppName ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Notify.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@appName@/: the localised application name
    -> m ()
notificationSetAppName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> m ()
notificationSetAppName a
notification Text
appName = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
appName' <- Text -> IO CString
textToCString Text
appName
    Ptr Notification -> CString -> IO ()
notify_notification_set_app_name Ptr Notification
notification' CString
appName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
appName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetAppNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetAppName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetAppName"
        })


#endif

-- method Notification::set_category
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "category"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The category." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_category" notify_notification_set_category :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- category : TBasicType TUTF8
    IO ()

-- | Sets the category of this notification. This can be used by the
-- notification server to filter or display the data in a certain way.
notificationSetCategory ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@category@/: The category.
    -> m ()
notificationSetCategory :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> m ()
notificationSetCategory a
notification 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
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
category' <- Text -> IO CString
textToCString Text
category
    Ptr Notification -> CString -> IO ()
notify_notification_set_category Ptr Notification
notification' CString
category'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
category'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetCategoryMethodInfo
instance (signature ~ (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.Notify.Objects.Notification.notificationSetCategory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetCategory"
        })


#endif

-- method Notification::set_hint
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #NotifyNotification"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hint key" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the hint value, or %NULL to unset the hint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint" notify_notification_set_hint :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Sets a hint for /@key@/ with value /@value@/. If /@value@/ is 'P.Nothing',
-- a previously set hint for /@key@/ is unset.
-- 
-- If /@value@/ is floating, it is consumed.
-- 
-- /Since: 0.6/
notificationSetHint ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.Notify.Objects.Notification.Notification'
    -> T.Text
    -- ^ /@key@/: the hint key
    -> Maybe (GVariant)
    -- ^ /@value@/: the hint value, or 'P.Nothing' to unset the hint
    -> m ()
notificationSetHint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Maybe GVariant -> m ()
notificationSetHint a
notification Text
key Maybe GVariant
value = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr GVariant
maybeValue <- case Maybe GVariant
value 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
nullPtr
        Just GVariant
jValue -> do
            Ptr GVariant
jValue' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jValue
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jValue'
    Ptr Notification -> CString -> Ptr GVariant -> IO ()
notify_notification_set_hint Ptr Notification
notification' CString
key' Ptr GVariant
maybeValue
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
value GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHint"
        })


#endif

-- method Notification::set_hint_byte
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint's value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint_byte" notify_notification_set_hint_byte :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    Word8 ->                                -- value : TBasicType TUInt8
    IO ()

{-# DEPRECATED notificationSetHintByte ["(Since version 0.6.)","Use 'GI.Notify.Objects.Notification.notificationSetHint' instead"] #-}
-- | Sets a hint with a byte value.
notificationSetHintByte ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@key@/: The hint.
    -> Word8
    -- ^ /@value@/: The hint\'s value.
    -> m ()
notificationSetHintByte :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Word8 -> m ()
notificationSetHintByte a
notification Text
key Word8
value = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr Notification -> CString -> Word8 -> IO ()
notify_notification_set_hint_byte Ptr Notification
notification' CString
key' Word8
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintByteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHintByte",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHintByte"
        })


#endif

-- method Notification::set_hint_byte_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint's value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The length of the byte array."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "len"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "The length of the byte array."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint_byte_array" notify_notification_set_hint_byte_array :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    Ptr Word8 ->                            -- value : TCArray False (-1) 3 (TBasicType TUInt8)
    Word64 ->                               -- len : TBasicType TUInt64
    IO ()

{-# DEPRECATED notificationSetHintByteArray ["(Since version 0.6.)","Use 'GI.Notify.Objects.Notification.notificationSetHint' instead"] #-}
-- | Sets a hint with a byte array value. The length of /@value@/ must be passed
-- as /@len@/.
notificationSetHintByteArray ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@key@/: The hint.
    -> ByteString
    -- ^ /@value@/: The hint\'s value.
    -> m ()
notificationSetHintByteArray :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> ByteString -> m ()
notificationSetHintByteArray a
notification Text
key ByteString
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let len :: Word64
len = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
value
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr Word8
value' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
value
    Ptr Notification -> CString -> Ptr Word8 -> Word64 -> IO ()
notify_notification_set_hint_byte_array Ptr Notification
notification' CString
key' Ptr Word8
value' Word64
len
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintByteArrayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHintByteArray",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHintByteArray"
        })


#endif

-- method Notification::set_hint_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint's value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint_double" notify_notification_set_hint_double :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

{-# DEPRECATED notificationSetHintDouble ["(Since version 0.6.)","Use 'GI.Notify.Objects.Notification.notificationSetHint' instead"] #-}
-- | Sets a hint with a double value.
notificationSetHintDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@key@/: The hint.
    -> Double
    -- ^ /@value@/: The hint\'s value.
    -> m ()
notificationSetHintDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Double -> m ()
notificationSetHintDouble a
notification Text
key Double
value = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Notification -> CString -> CDouble -> IO ()
notify_notification_set_hint_double Ptr Notification
notification' CString
key' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintDoubleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHintDouble",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHintDouble"
        })


#endif

-- method Notification::set_hint_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint's value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint_int32" notify_notification_set_hint_int32 :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    Int32 ->                                -- value : TBasicType TInt
    IO ()

{-# DEPRECATED notificationSetHintInt32 ["(Since version 0.6.)","Use 'GI.Notify.Objects.Notification.notificationSetHint' instead"] #-}
-- | Sets a hint with a 32-bit integer value.
notificationSetHintInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@key@/: The hint.
    -> Int32
    -- ^ /@value@/: The hint\'s value.
    -> m ()
notificationSetHintInt32 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Int32 -> m ()
notificationSetHintInt32 a
notification Text
key Int32
value = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr Notification -> CString -> Int32 -> IO ()
notify_notification_set_hint_int32 Ptr Notification
notification' CString
key' Int32
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintInt32MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHintInt32",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHintInt32"
        })


#endif

-- method Notification::set_hint_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint's value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint_string" notify_notification_set_hint_string :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO ()

{-# DEPRECATED notificationSetHintString ["(Since version 0.6.)","Use 'GI.Notify.Objects.Notification.notificationSetHint' instead"] #-}
-- | Sets a hint with a string value.
notificationSetHintString ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@key@/: The hint.
    -> T.Text
    -- ^ /@value@/: The hint\'s value.
    -> m ()
notificationSetHintString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Text -> m ()
notificationSetHintString a
notification Text
key Text
value = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr Notification -> CString -> CString -> IO ()
notify_notification_set_hint_string Ptr Notification
notification' CString
key' CString
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHintString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHintString"
        })


#endif

-- method Notification::set_hint_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The hint's value." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_hint_uint32" notify_notification_set_hint_uint32 :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- key : TBasicType TUTF8
    Word32 ->                               -- value : TBasicType TUInt
    IO ()

{-# DEPRECATED notificationSetHintUint32 ["(Since version 0.6.)","Use 'GI.Notify.Objects.Notification.notificationSetHint' instead"] #-}
-- | Sets a hint with an unsigned 32-bit integer value.
notificationSetHintUint32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> T.Text
    -- ^ /@key@/: The hint.
    -> Word32
    -- ^ /@value@/: The hint\'s value.
    -> m ()
notificationSetHintUint32 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Word32 -> m ()
notificationSetHintUint32 a
notification Text
key Word32
value = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
key' <- Text -> IO CString
textToCString Text
key
    Ptr Notification -> CString -> Word32 -> IO ()
notify_notification_set_hint_uint32 Ptr Notification
notification' CString
key' Word32
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo NotificationSetHintUint32MethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetHintUint32",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetHintUint32"
        })


#endif

-- method Notification::set_icon_from_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The icon." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_icon_from_pixbuf" notify_notification_set_icon_from_pixbuf :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- icon : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO ()

{-# DEPRECATED notificationSetIconFromPixbuf ["use 'GI.Notify.Objects.Notification.notificationSetImageFromPixbuf' instead."] #-}
-- | Sets the icon in the notification from a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'.
notificationSetIconFromPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -- ^ /@notification@/: The notification.
    -> b
    -- ^ /@icon@/: The icon.
    -> m ()
notificationSetIconFromPixbuf :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotification a, IsPixbuf b) =>
a -> b -> m ()
notificationSetIconFromPixbuf 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
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Pixbuf
icon' <- b -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
icon
    Ptr Notification -> Ptr Pixbuf -> IO ()
notify_notification_set_icon_from_pixbuf Ptr Notification
notification' Ptr Pixbuf
icon'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
icon
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetIconFromPixbufMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsNotification a, GdkPixbuf.Pixbuf.IsPixbuf b) => O.OverloadedMethod NotificationSetIconFromPixbufMethodInfo a signature where
    overloadedMethod = notificationSetIconFromPixbuf

instance O.OverloadedMethodInfo NotificationSetIconFromPixbufMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetIconFromPixbuf",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetIconFromPixbuf"
        })


#endif

-- method Notification::set_image_from_pixbuf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pixbuf"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "Pixbuf" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The image." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_image_from_pixbuf" notify_notification_set_image_from_pixbuf :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    Ptr GdkPixbuf.Pixbuf.Pixbuf ->          -- pixbuf : TInterface (Name {namespace = "GdkPixbuf", name = "Pixbuf"})
    IO ()

-- | Sets the image in the notification from a t'GI.GdkPixbuf.Objects.Pixbuf.Pixbuf'.
notificationSetImageFromPixbuf ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a, GdkPixbuf.Pixbuf.IsPixbuf b) =>
    a
    -- ^ /@notification@/: The notification.
    -> b
    -- ^ /@pixbuf@/: The image.
    -> m ()
notificationSetImageFromPixbuf :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsNotification a, IsPixbuf b) =>
a -> b -> m ()
notificationSetImageFromPixbuf a
notification b
pixbuf = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Pixbuf
pixbuf' <- b -> IO (Ptr Pixbuf)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
pixbuf
    Ptr Notification -> Ptr Pixbuf -> IO ()
notify_notification_set_image_from_pixbuf Ptr Notification
notification' Ptr Pixbuf
pixbuf'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
pixbuf
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetImageFromPixbufMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsNotification a, GdkPixbuf.Pixbuf.IsPixbuf b) => O.OverloadedMethod NotificationSetImageFromPixbufMethodInfo a signature where
    overloadedMethod = notificationSetImageFromPixbuf

instance O.OverloadedMethodInfo NotificationSetImageFromPixbufMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetImageFromPixbuf",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetImageFromPixbuf"
        })


#endif

-- method Notification::set_timeout
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "timeout"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The timeout in milliseconds."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_timeout" notify_notification_set_timeout :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    Int32 ->                                -- timeout : TBasicType TInt
    IO ()

-- | Sets the timeout of the notification. To set the default time, pass
-- 'GI.Notify.Constants.EXPIRES_DEFAULT' as /@timeout@/. To set the notification to never
-- expire, pass 'GI.Notify.Constants.EXPIRES_NEVER'.
-- 
-- Note that the timeout may be ignored by the server.
notificationSetTimeout ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> Int32
    -- ^ /@timeout@/: The timeout in milliseconds.
    -> m ()
notificationSetTimeout :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Int32 -> m ()
notificationSetTimeout a
notification Int32
timeout = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Notification -> Int32 -> IO ()
notify_notification_set_timeout Ptr Notification
notification' Int32
timeout
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetTimeoutMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationSetTimeoutMethodInfo a signature where
    overloadedMethod = notificationSetTimeout

instance O.OverloadedMethodInfo NotificationSetTimeoutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetTimeout",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetTimeout"
        })


#endif

-- method Notification::set_urgency
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "urgency"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Urgency" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The urgency level." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_set_urgency" notify_notification_set_urgency :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CUInt ->                                -- urgency : TInterface (Name {namespace = "Notify", name = "Urgency"})
    IO ()

-- | Sets the urgency level of this notification.
-- 
-- See: t'GI.Notify.Enums.Urgency'
notificationSetUrgency ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> Notify.Enums.Urgency
    -- ^ /@urgency@/: The urgency level.
    -> m ()
notificationSetUrgency :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Urgency -> m ()
notificationSetUrgency a
notification Urgency
urgency = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    let urgency' :: CUInt
urgency' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Urgency -> Int) -> Urgency -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Urgency -> Int
forall a. Enum a => a -> Int
fromEnum) Urgency
urgency
    Ptr Notification -> CUInt -> IO ()
notify_notification_set_urgency Ptr Notification
notification' CUInt
urgency'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationSetUrgencyMethodInfo
instance (signature ~ (Notify.Enums.Urgency -> m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationSetUrgencyMethodInfo a signature where
    overloadedMethod = notificationSetUrgency

instance O.OverloadedMethodInfo NotificationSetUrgencyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationSetUrgency",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationSetUrgency"
        })


#endif

-- method Notification::show
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "notify_notification_show" notify_notification_show :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tells the notification server to display the notification on the screen.
notificationShow ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
notificationShow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> m ()
notificationShow a
notification = 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 Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Notification -> Ptr (Ptr GError) -> IO CInt
notify_notification_show Ptr Notification
notification'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data NotificationShowMethodInfo
instance (signature ~ (m ()), MonadIO m, IsNotification a) => O.OverloadedMethod NotificationShowMethodInfo a signature where
    overloadedMethod = notificationShow

instance O.OverloadedMethodInfo NotificationShowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationShow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationShow"
        })


#endif

-- method Notification::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "Notify" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The notification to update."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "summary"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new required summary text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The optional body text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "icon"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The optional icon theme icon name or filename."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "notify_notification_update" notify_notification_update :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "Notify", name = "Notification"})
    CString ->                              -- summary : TBasicType TUTF8
    CString ->                              -- body : TBasicType TUTF8
    CString ->                              -- icon : TBasicType TUTF8
    IO CInt

-- | Updates the notification text and icon. This won\'t send the update out
-- and display it on the screen. For that, you will need to call
-- 'GI.Notify.Objects.Notification.notificationShow'.
notificationUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: The notification to update.
    -> T.Text
    -- ^ /@summary@/: The new required summary text.
    -> Maybe (T.Text)
    -- ^ /@body@/: The optional body text.
    -> Maybe (T.Text)
    -- ^ /@icon@/: The optional icon theme icon name or filename.
    -> m Bool
    -- ^ __Returns:__ 'P.True', unless an invalid parameter was passed.
notificationUpdate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotification a) =>
a -> Text -> Maybe Text -> Maybe Text -> m Bool
notificationUpdate a
notification Text
summary Maybe Text
body Maybe Text
icon = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    CString
summary' <- Text -> IO CString
textToCString Text
summary
    CString
maybeBody <- case Maybe Text
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
nullPtr
        Just Text
jBody -> do
            CString
jBody' <- Text -> IO CString
textToCString Text
jBody
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jBody'
    CString
maybeIcon <- case Maybe Text
icon 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
jIcon -> do
            CString
jIcon' <- Text -> IO CString
textToCString Text
jIcon
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jIcon'
    CInt
result <- Ptr Notification -> CString -> CString -> CString -> IO CInt
notify_notification_update Ptr Notification
notification' CString
summary' CString
maybeBody CString
maybeIcon
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
summary'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeIcon
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo NotificationUpdateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Notify.Objects.Notification.notificationUpdate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-notify-0.7.25/docs/GI-Notify-Objects-Notification.html#v:notificationUpdate"
        })


#endif