{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.WebKit2.Objects.Notification
    ( 

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


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveNotificationMethod               ,
#endif


-- ** clicked #method:clicked#

#if defined(ENABLE_OVERLOADING)
    NotificationClickedMethodInfo           ,
#endif
    notificationClicked                     ,


-- ** close #method:close#

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


-- ** getBody #method:getBody#

#if defined(ENABLE_OVERLOADING)
    NotificationGetBodyMethodInfo           ,
#endif
    notificationGetBody                     ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    NotificationGetIdMethodInfo             ,
#endif
    notificationGetId                       ,


-- ** getTag #method:getTag#

#if defined(ENABLE_OVERLOADING)
    NotificationGetTagMethodInfo            ,
#endif
    notificationGetTag                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    NotificationGetTitleMethodInfo          ,
#endif
    notificationGetTitle                    ,




 -- * Properties
-- ** body #attr:body#
-- | The body for the notification.
-- 
-- /Since: 2.8/

#if defined(ENABLE_OVERLOADING)
    NotificationBodyPropertyInfo            ,
#endif
    getNotificationBody                     ,
#if defined(ENABLE_OVERLOADING)
    notificationBody                        ,
#endif


-- ** id #attr:id#
-- | The unique id for the notification.
-- 
-- /Since: 2.8/

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


-- ** tag #attr:tag#
-- | The tag identifier for the notification.
-- 
-- /Since: 2.16/

#if defined(ENABLE_OVERLOADING)
    NotificationTagPropertyInfo             ,
#endif
    getNotificationTag                      ,
#if defined(ENABLE_OVERLOADING)
    notificationTag                         ,
#endif


-- ** title #attr:title#
-- | The title for the notification.
-- 
-- /Since: 2.8/

#if defined(ENABLE_OVERLOADING)
    NotificationTitlePropertyInfo           ,
#endif
    getNotificationTitle                    ,
#if defined(ENABLE_OVERLOADING)
    notificationTitle                       ,
#endif




 -- * Signals
-- ** clicked #signal:clicked#

    C_NotificationClickedCallback           ,
    NotificationClickedCallback             ,
#if defined(ENABLE_OVERLOADING)
    NotificationClickedSignalInfo           ,
#endif
    afterNotificationClicked                ,
    genClosure_NotificationClicked          ,
    mk_NotificationClickedCallback          ,
    noNotificationClickedCallback           ,
    onNotificationClicked                   ,
    wrap_NotificationClickedCallback        ,


-- ** closed #signal:closed#

    C_NotificationClosedCallback            ,
    NotificationClosedCallback              ,
#if defined(ENABLE_OVERLOADING)
    NotificationClosedSignalInfo            ,
#endif
    afterNotificationClosed                 ,
    genClosure_NotificationClosed           ,
    mk_NotificationClosedCallback           ,
    noNotificationClosedCallback            ,
    onNotificationClosed                    ,
    wrap_NotificationClosedCallback         ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object

-- | Memory-managed wrapper type.
newtype Notification = Notification (ManagedPtr Notification)
    deriving (Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c== :: Notification -> Notification -> Bool
Eq)
foreign import ccall "webkit_notification_get_type"
    c_webkit_notification_get_type :: IO GType

instance GObject Notification where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_notification_get_type
    

-- | Convert 'Notification' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Notification where
    toGValue :: Notification -> IO GValue
toGValue o :: Notification
o = do
        GType
gtype <- IO GType
c_webkit_notification_get_type
        Notification -> (Ptr Notification -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Notification
o (GType
-> (GValue -> Ptr Notification -> IO ())
-> Ptr Notification
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Notification -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Notification
fromGValue gv :: GValue
gv = do
        Ptr Notification
ptr <- GValue -> IO (Ptr Notification)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Notification)
        (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
        
    

-- | Type class for types which can be safely cast to `Notification`, for instance with `toNotification`.
class (GObject o, O.IsDescendantOf Notification o) => IsNotification o
instance (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 :: (MonadIO m, IsNotification o) => o -> m Notification
toNotification :: o -> m Notification
toNotification = IO Notification -> m Notification
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Notification -> Notification
Notification

-- | A convenience alias for `Nothing` :: `Maybe` `Notification`.
noNotification :: Maybe Notification
noNotification :: Maybe Notification
noNotification = Maybe Notification
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveNotificationMethod (t :: Symbol) (o :: *) :: * where
    ResolveNotificationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveNotificationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveNotificationMethod "clicked" o = NotificationClickedMethodInfo
    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 "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveNotificationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveNotificationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveNotificationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveNotificationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveNotificationMethod "getBody" o = NotificationGetBodyMethodInfo
    ResolveNotificationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveNotificationMethod "getId" o = NotificationGetIdMethodInfo
    ResolveNotificationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveNotificationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveNotificationMethod "getTag" o = NotificationGetTagMethodInfo
    ResolveNotificationMethod "getTitle" o = NotificationGetTitleMethodInfo
    ResolveNotificationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveNotificationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveNotificationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveNotificationMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveNotificationMethod t Notification, O.MethodInfo 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

#endif

-- signal Notification::clicked
-- | Emitted when a notification has been clicked. See 'GI.WebKit2.Objects.Notification.notificationClicked'.
-- 
-- /Since: 2.12/
type NotificationClickedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `NotificationClickedCallback`@.
noNotificationClickedCallback :: Maybe NotificationClickedCallback
noNotificationClickedCallback :: Maybe (IO ())
noNotificationClickedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_NotificationClickedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_NotificationClicked :: MonadIO m => NotificationClickedCallback -> m (GClosure C_NotificationClickedCallback)
genClosure_NotificationClicked :: IO () -> m (GClosure C_NotificationClickedCallback)
genClosure_NotificationClicked cb :: IO ()
cb = IO (GClosure C_NotificationClickedCallback)
-> m (GClosure C_NotificationClickedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_NotificationClickedCallback)
 -> m (GClosure C_NotificationClickedCallback))
-> IO (GClosure C_NotificationClickedCallback)
-> m (GClosure C_NotificationClickedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_NotificationClickedCallback
cb' = IO () -> C_NotificationClickedCallback
wrap_NotificationClickedCallback IO ()
cb
    C_NotificationClickedCallback
-> IO (FunPtr C_NotificationClickedCallback)
mk_NotificationClickedCallback C_NotificationClickedCallback
cb' IO (FunPtr C_NotificationClickedCallback)
-> (FunPtr C_NotificationClickedCallback
    -> IO (GClosure C_NotificationClickedCallback))
-> IO (GClosure C_NotificationClickedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_NotificationClickedCallback
-> IO (GClosure C_NotificationClickedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `NotificationClickedCallback` into a `C_NotificationClickedCallback`.
wrap_NotificationClickedCallback ::
    NotificationClickedCallback ->
    C_NotificationClickedCallback
wrap_NotificationClickedCallback :: IO () -> C_NotificationClickedCallback
wrap_NotificationClickedCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [clicked](#signal:clicked) 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 #clicked callback
-- @
-- 
-- 
onNotificationClicked :: (IsNotification a, MonadIO m) => a -> NotificationClickedCallback -> m SignalHandlerId
onNotificationClicked :: a -> IO () -> m SignalHandlerId
onNotificationClicked obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_NotificationClickedCallback
cb' = IO () -> C_NotificationClickedCallback
wrap_NotificationClickedCallback IO ()
cb
    FunPtr C_NotificationClickedCallback
cb'' <- C_NotificationClickedCallback
-> IO (FunPtr C_NotificationClickedCallback)
mk_NotificationClickedCallback C_NotificationClickedCallback
cb'
    a
-> Text
-> FunPtr C_NotificationClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "clicked" FunPtr C_NotificationClickedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [clicked](#signal:clicked) 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 #clicked callback
-- @
-- 
-- 
afterNotificationClicked :: (IsNotification a, MonadIO m) => a -> NotificationClickedCallback -> m SignalHandlerId
afterNotificationClicked :: a -> IO () -> m SignalHandlerId
afterNotificationClicked obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_NotificationClickedCallback
cb' = IO () -> C_NotificationClickedCallback
wrap_NotificationClickedCallback IO ()
cb
    FunPtr C_NotificationClickedCallback
cb'' <- C_NotificationClickedCallback
-> IO (FunPtr C_NotificationClickedCallback)
mk_NotificationClickedCallback C_NotificationClickedCallback
cb'
    a
-> Text
-> FunPtr C_NotificationClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "clicked" FunPtr C_NotificationClickedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data NotificationClickedSignalInfo
instance SignalInfo NotificationClickedSignalInfo where
    type HaskellCallbackType NotificationClickedSignalInfo = NotificationClickedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_NotificationClickedCallback cb
        cb'' <- mk_NotificationClickedCallback cb'
        connectSignalFunPtr obj "clicked" cb'' connectMode detail

#endif

-- signal Notification::closed
-- | Emitted when a notification has been withdrawn.
-- 
-- The default handler will close the notification using libnotify, if built with
-- support for it.
-- 
-- /Since: 2.8/
type NotificationClosedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `NotificationClosedCallback`@.
noNotificationClosedCallback :: Maybe NotificationClosedCallback
noNotificationClosedCallback :: Maybe (IO ())
noNotificationClosedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_NotificationClosedCallback =
    Ptr () ->                               -- 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 the callback into a `GClosure`.
genClosure_NotificationClosed :: MonadIO m => NotificationClosedCallback -> m (GClosure C_NotificationClosedCallback)
genClosure_NotificationClosed :: IO () -> m (GClosure C_NotificationClickedCallback)
genClosure_NotificationClosed cb :: IO ()
cb = IO (GClosure C_NotificationClickedCallback)
-> m (GClosure C_NotificationClickedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_NotificationClickedCallback)
 -> m (GClosure C_NotificationClickedCallback))
-> IO (GClosure C_NotificationClickedCallback)
-> m (GClosure C_NotificationClickedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_NotificationClickedCallback
cb' = IO () -> C_NotificationClickedCallback
wrap_NotificationClosedCallback IO ()
cb
    C_NotificationClickedCallback
-> IO (FunPtr C_NotificationClickedCallback)
mk_NotificationClosedCallback C_NotificationClickedCallback
cb' IO (FunPtr C_NotificationClickedCallback)
-> (FunPtr C_NotificationClickedCallback
    -> IO (GClosure C_NotificationClickedCallback))
-> IO (GClosure C_NotificationClickedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_NotificationClickedCallback
-> IO (GClosure C_NotificationClickedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `NotificationClosedCallback` into a `C_NotificationClosedCallback`.
wrap_NotificationClosedCallback ::
    NotificationClosedCallback ->
    C_NotificationClosedCallback
wrap_NotificationClosedCallback :: IO () -> C_NotificationClickedCallback
wrap_NotificationClosedCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | 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 -> NotificationClosedCallback -> m SignalHandlerId
onNotificationClosed :: a -> IO () -> m SignalHandlerId
onNotificationClosed obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_NotificationClickedCallback
cb' = IO () -> C_NotificationClickedCallback
wrap_NotificationClosedCallback IO ()
cb
    FunPtr C_NotificationClickedCallback
cb'' <- C_NotificationClickedCallback
-> IO (FunPtr C_NotificationClickedCallback)
mk_NotificationClosedCallback C_NotificationClickedCallback
cb'
    a
-> Text
-> FunPtr C_NotificationClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "closed" FunPtr C_NotificationClickedCallback
cb'' 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
-- @
-- 
-- 
afterNotificationClosed :: (IsNotification a, MonadIO m) => a -> NotificationClosedCallback -> m SignalHandlerId
afterNotificationClosed :: a -> IO () -> m SignalHandlerId
afterNotificationClosed obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_NotificationClickedCallback
cb' = IO () -> C_NotificationClickedCallback
wrap_NotificationClosedCallback IO ()
cb
    FunPtr C_NotificationClickedCallback
cb'' <- C_NotificationClickedCallback
-> IO (FunPtr C_NotificationClickedCallback)
mk_NotificationClosedCallback C_NotificationClickedCallback
cb'
    a
-> Text
-> FunPtr C_NotificationClickedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "closed" FunPtr C_NotificationClickedCallback
cb'' 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

#endif

-- VVV Prop "body"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,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 T.Text
getNotificationBody :: o -> m Text
getNotificationBody obj :: o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getNotificationBody" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "body"

#if defined(ENABLE_OVERLOADING)
data NotificationBodyPropertyInfo
instance AttrInfo NotificationBodyPropertyInfo where
    type AttrAllowedOps NotificationBodyPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotificationBodyPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationBodyPropertyInfo = (~) ()
    type AttrTransferTypeConstraint NotificationBodyPropertyInfo = (~) ()
    type AttrTransferType NotificationBodyPropertyInfo = ()
    type AttrGetType NotificationBodyPropertyInfo = T.Text
    type AttrLabel NotificationBodyPropertyInfo = "body"
    type AttrOrigin NotificationBodyPropertyInfo = Notification
    attrGet = getNotificationBody
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data NotificationIdPropertyInfo
instance AttrInfo NotificationIdPropertyInfo where
    type AttrAllowedOps NotificationIdPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint NotificationIdPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationIdPropertyInfo = (~) ()
    type AttrTransferTypeConstraint NotificationIdPropertyInfo = (~) ()
    type AttrTransferType NotificationIdPropertyInfo = ()
    type AttrGetType NotificationIdPropertyInfo = Word64
    type AttrLabel NotificationIdPropertyInfo = "id"
    type AttrOrigin NotificationIdPropertyInfo = Notification
    attrGet = getNotificationId
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "tag"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just True,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data NotificationTagPropertyInfo
instance AttrInfo NotificationTagPropertyInfo where
    type AttrAllowedOps NotificationTagPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotificationTagPropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationTagPropertyInfo = (~) ()
    type AttrTransferTypeConstraint NotificationTagPropertyInfo = (~) ()
    type AttrTransferType NotificationTagPropertyInfo = ()
    type AttrGetType NotificationTagPropertyInfo = (Maybe T.Text)
    type AttrLabel NotificationTagPropertyInfo = "tag"
    type AttrOrigin NotificationTagPropertyInfo = Notification
    attrGet = getNotificationTag
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

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

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

#if defined(ENABLE_OVERLOADING)
data NotificationTitlePropertyInfo
instance AttrInfo NotificationTitlePropertyInfo where
    type AttrAllowedOps NotificationTitlePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint NotificationTitlePropertyInfo = IsNotification
    type AttrSetTypeConstraint NotificationTitlePropertyInfo = (~) ()
    type AttrTransferTypeConstraint NotificationTitlePropertyInfo = (~) ()
    type AttrTransferType NotificationTitlePropertyInfo = ()
    type AttrGetType NotificationTitlePropertyInfo = T.Text
    type AttrLabel NotificationTitlePropertyInfo = "title"
    type AttrOrigin NotificationTitlePropertyInfo = Notification
    attrGet = getNotificationTitle
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Notification
type instance O.AttributeList Notification = NotificationAttributeList
type NotificationAttributeList = ('[ '("body", NotificationBodyPropertyInfo), '("id", NotificationIdPropertyInfo), '("tag", NotificationTagPropertyInfo), '("title", NotificationTitlePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
notificationBody :: AttrLabelProxy "body"
notificationBody = AttrLabelProxy

notificationId :: AttrLabelProxy "id"
notificationId = AttrLabelProxy

notificationTag :: AttrLabelProxy "tag"
notificationTag = AttrLabelProxy

notificationTitle :: AttrLabelProxy "title"
notificationTitle = AttrLabelProxy

#endif

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

#endif

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

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

-- | Tells WebKit the notification has been clicked. This will emit the
-- [clicked]("GI.WebKit2.Objects.Notification#signal:clicked") signal.
-- 
-- /Since: 2.12/
notificationClicked ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.WebKit2.Objects.Notification.Notification'
    -> m ()
notificationClicked :: a -> m ()
notificationClicked notification :: a
notification = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Notification -> IO ()
webkit_notification_clicked Ptr Notification
notification'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NotificationClickedMethodInfo
instance (signature ~ (m ()), MonadIO m, IsNotification a) => O.MethodInfo NotificationClickedMethodInfo a signature where
    overloadedMethod = notificationClicked

#endif

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

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

-- | Closes the notification.
-- 
-- /Since: 2.8/
notificationClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.WebKit2.Objects.Notification.Notification'
    -> m ()
notificationClose :: a -> m ()
notificationClose notification :: a
notification = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Notification
notification' <- a -> IO (Ptr Notification)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
notification
    Ptr Notification -> IO ()
webkit_notification_close Ptr Notification
notification'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

#endif

-- method Notification::get_body
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNotification"
--                 , 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 "webkit_notification_get_body" webkit_notification_get_body :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "WebKit2", name = "Notification"})
    IO CString

-- | Obtains the body for the notification.
-- 
-- /Since: 2.8/
notificationGetBody ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.WebKit2.Objects.Notification.Notification'
    -> m T.Text
    -- ^ __Returns:__ the body for the notification
notificationGetBody :: a -> m Text
notificationGetBody notification :: a
notification = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
webkit_notification_get_body Ptr Notification
notification'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "notificationGetBody" 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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NotificationGetBodyMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsNotification a) => O.MethodInfo NotificationGetBodyMethodInfo a signature where
    overloadedMethod = notificationGetBody

#endif

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

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

-- | Obtains the unique id for the notification.
-- 
-- /Since: 2.8/
notificationGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.WebKit2.Objects.Notification.Notification'
    -> m Word64
    -- ^ __Returns:__ the unique id for the notification
notificationGetId :: a -> m Word64
notificationGetId notification :: a
notification = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
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
    Word64
result <- Ptr Notification -> IO Word64
webkit_notification_get_id Ptr Notification
notification'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data NotificationGetIdMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsNotification a) => O.MethodInfo NotificationGetIdMethodInfo a signature where
    overloadedMethod = notificationGetId

#endif

-- method Notification::get_tag
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNotification"
--                 , 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 "webkit_notification_get_tag" webkit_notification_get_tag :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "WebKit2", name = "Notification"})
    IO CString

-- | Obtains the tag identifier for the notification.
-- 
-- /Since: 2.16/
notificationGetTag ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.WebKit2.Objects.Notification.Notification'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the tag for the notification
notificationGetTag :: a -> m (Maybe Text)
notificationGetTag notification :: a
notification = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe 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
webkit_notification_get_tag Ptr Notification
notification'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
notification
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data NotificationGetTagMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsNotification a) => O.MethodInfo NotificationGetTagMethodInfo a signature where
    overloadedMethod = notificationGetTag

#endif

-- method Notification::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "notification"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Notification" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitNotification"
--                 , 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 "webkit_notification_get_title" webkit_notification_get_title :: 
    Ptr Notification ->                     -- notification : TInterface (Name {namespace = "WebKit2", name = "Notification"})
    IO CString

-- | Obtains the title for the notification.
-- 
-- /Since: 2.8/
notificationGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsNotification a) =>
    a
    -- ^ /@notification@/: a t'GI.WebKit2.Objects.Notification.Notification'
    -> m T.Text
    -- ^ __Returns:__ the title for the notification
notificationGetTitle :: a -> m Text
notificationGetTitle notification :: a
notification = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr 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
webkit_notification_get_title Ptr Notification
notification'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "notificationGetTitle" 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 (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NotificationGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsNotification a) => O.MethodInfo NotificationGetTitleMethodInfo a signature where
    overloadedMethod = notificationGetTitle

#endif