{-# 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.UserMessage
    ( 

-- * Exported types
    UserMessage(..)                         ,
    IsUserMessage                           ,
    toUserMessage                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [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"), [sendReply]("GI.WebKit2.Objects.UserMessage#g:method:sendReply"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFdList]("GI.WebKit2.Objects.UserMessage#g:method:getFdList"), [getName]("GI.WebKit2.Objects.UserMessage#g:method:getName"), [getParameters]("GI.WebKit2.Objects.UserMessage#g:method:getParameters"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveUserMessageMethod                ,
#endif

-- ** getFdList #method:getFdList#

#if defined(ENABLE_OVERLOADING)
    UserMessageGetFdListMethodInfo          ,
#endif
    userMessageGetFdList                    ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    UserMessageGetNameMethodInfo            ,
#endif
    userMessageGetName                      ,


-- ** getParameters #method:getParameters#

#if defined(ENABLE_OVERLOADING)
    UserMessageGetParametersMethodInfo      ,
#endif
    userMessageGetParameters                ,


-- ** new #method:new#

    userMessageNew                          ,


-- ** newWithFdList #method:newWithFdList#

    userMessageNewWithFdList                ,


-- ** sendReply #method:sendReply#

#if defined(ENABLE_OVERLOADING)
    UserMessageSendReplyMethodInfo          ,
#endif
    userMessageSendReply                    ,




 -- * Properties


-- ** fdList #attr:fdList#
-- | The UNIX file descriptors of the user message.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    UserMessageFdListPropertyInfo           ,
#endif
    constructUserMessageFdList              ,
    getUserMessageFdList                    ,
#if defined(ENABLE_OVERLOADING)
    userMessageFdList                       ,
#endif


-- ** name #attr:name#
-- | The name of the user message.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    UserMessageNamePropertyInfo             ,
#endif
    constructUserMessageName                ,
    getUserMessageName                      ,
#if defined(ENABLE_OVERLOADING)
    userMessageName                         ,
#endif


-- ** parameters #attr:parameters#
-- | The parameters of the user message as a t'GVariant', or 'P.Nothing'
-- if the message doesn\'t include parameters. Note that only complete types are
-- allowed.
-- 
-- /Since: 2.28/

#if defined(ENABLE_OVERLOADING)
    UserMessageParametersPropertyInfo       ,
#endif
    constructUserMessageParameters          ,
    getUserMessageParameters                ,
#if defined(ENABLE_OVERLOADING)
    userMessageParameters                   ,
#endif




    ) 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.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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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

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

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

foreign import ccall "webkit_user_message_get_type"
    c_webkit_user_message_get_type :: IO B.Types.GType

instance B.Types.TypedObject UserMessage where
    glibType :: IO GType
glibType = IO GType
c_webkit_user_message_get_type

instance B.Types.GObject UserMessage

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveUserMessageMethod (t :: Symbol) (o :: *) :: * where
    ResolveUserMessageMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveUserMessageMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveUserMessageMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveUserMessageMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveUserMessageMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveUserMessageMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveUserMessageMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveUserMessageMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveUserMessageMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveUserMessageMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveUserMessageMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveUserMessageMethod "sendReply" o = UserMessageSendReplyMethodInfo
    ResolveUserMessageMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveUserMessageMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveUserMessageMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveUserMessageMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveUserMessageMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveUserMessageMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveUserMessageMethod "getFdList" o = UserMessageGetFdListMethodInfo
    ResolveUserMessageMethod "getName" o = UserMessageGetNameMethodInfo
    ResolveUserMessageMethod "getParameters" o = UserMessageGetParametersMethodInfo
    ResolveUserMessageMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveUserMessageMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveUserMessageMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveUserMessageMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveUserMessageMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveUserMessageMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "fd-list"
   -- Type: TInterface (Name {namespace = "Gio", name = "UnixFDList"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@fd-list@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUserMessageFdList :: (IsUserMessage o, MIO.MonadIO m, Gio.UnixFDList.IsUnixFDList a) => a -> m (GValueConstruct o)
constructUserMessageFdList :: forall o (m :: * -> *) a.
(IsUserMessage o, MonadIO m, IsUnixFDList a) =>
a -> m (GValueConstruct o)
constructUserMessageFdList a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"fd-list" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data UserMessageFdListPropertyInfo
instance AttrInfo UserMessageFdListPropertyInfo where
    type AttrAllowedOps UserMessageFdListPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint UserMessageFdListPropertyInfo = IsUserMessage
    type AttrSetTypeConstraint UserMessageFdListPropertyInfo = Gio.UnixFDList.IsUnixFDList
    type AttrTransferTypeConstraint UserMessageFdListPropertyInfo = Gio.UnixFDList.IsUnixFDList
    type AttrTransferType UserMessageFdListPropertyInfo = Gio.UnixFDList.UnixFDList
    type AttrGetType UserMessageFdListPropertyInfo = Gio.UnixFDList.UnixFDList
    type AttrLabel UserMessageFdListPropertyInfo = "fd-list"
    type AttrOrigin UserMessageFdListPropertyInfo = UserMessage
    attrGet = getUserMessageFdList
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.UnixFDList.UnixFDList v
    attrConstruct = constructUserMessageFdList
    attrClear = undefined
#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data UserMessageNamePropertyInfo
instance AttrInfo UserMessageNamePropertyInfo where
    type AttrAllowedOps UserMessageNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint UserMessageNamePropertyInfo = IsUserMessage
    type AttrSetTypeConstraint UserMessageNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint UserMessageNamePropertyInfo = (~) T.Text
    type AttrTransferType UserMessageNamePropertyInfo = T.Text
    type AttrGetType UserMessageNamePropertyInfo = T.Text
    type AttrLabel UserMessageNamePropertyInfo = "name"
    type AttrOrigin UserMessageNamePropertyInfo = UserMessage
    attrGet = getUserMessageName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUserMessageName
    attrClear = undefined
#endif

-- VVV Prop "parameters"
   -- Type: TVariant
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@parameters@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructUserMessageParameters :: (IsUserMessage o, MIO.MonadIO m) => GVariant -> m (GValueConstruct o)
constructUserMessageParameters :: forall o (m :: * -> *).
(IsUserMessage o, MonadIO m) =>
GVariant -> m (GValueConstruct o)
constructUserMessageParameters GVariant
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 GVariant -> IO (GValueConstruct o)
forall o. String -> Maybe GVariant -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyVariant String
"parameters" (GVariant -> Maybe GVariant
forall a. a -> Maybe a
P.Just GVariant
val)

#if defined(ENABLE_OVERLOADING)
data UserMessageParametersPropertyInfo
instance AttrInfo UserMessageParametersPropertyInfo where
    type AttrAllowedOps UserMessageParametersPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint UserMessageParametersPropertyInfo = IsUserMessage
    type AttrSetTypeConstraint UserMessageParametersPropertyInfo = (~) GVariant
    type AttrTransferTypeConstraint UserMessageParametersPropertyInfo = (~) GVariant
    type AttrTransferType UserMessageParametersPropertyInfo = GVariant
    type AttrGetType UserMessageParametersPropertyInfo = GVariant
    type AttrLabel UserMessageParametersPropertyInfo = "parameters"
    type AttrOrigin UserMessageParametersPropertyInfo = UserMessage
    attrGet = getUserMessageParameters
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructUserMessageParameters
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UserMessage
type instance O.AttributeList UserMessage = UserMessageAttributeList
type UserMessageAttributeList = ('[ '("fdList", UserMessageFdListPropertyInfo), '("name", UserMessageNamePropertyInfo), '("parameters", UserMessageParametersPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
userMessageFdList :: AttrLabelProxy "fdList"
userMessageFdList = AttrLabelProxy

userMessageName :: AttrLabelProxy "name"
userMessageName = AttrLabelProxy

userMessageParameters :: AttrLabelProxy "parameters"
userMessageParameters = AttrLabelProxy

#endif

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

#endif

-- method UserMessage::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameters"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the message parameters as a #GVariant, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "UserMessage" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_message_new" webkit_user_message_new :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- parameters : TVariant
    IO (Ptr UserMessage)

-- | Create a new t'GI.WebKit2.Objects.UserMessage.UserMessage' with /@name@/.
-- 
-- /Since: 2.28/
userMessageNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@name@/: the message name
    -> Maybe (GVariant)
    -- ^ /@parameters@/: the message parameters as a t'GVariant', or 'P.Nothing'
    -> m UserMessage
    -- ^ __Returns:__ the newly created t'GI.WebKit2.Objects.UserMessage.UserMessage' object.
userMessageNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Maybe GVariant -> m UserMessage
userMessageNew Text
name Maybe GVariant
parameters = IO UserMessage -> m UserMessage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserMessage -> m UserMessage)
-> IO UserMessage -> m UserMessage
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
maybeParameters <- case Maybe GVariant
parameters of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just GVariant
jParameters -> do
            Ptr GVariant
jParameters' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jParameters
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jParameters'
    Ptr UserMessage
result <- CString -> Ptr GVariant -> IO (Ptr UserMessage)
webkit_user_message_new CString
name' Ptr GVariant
maybeParameters
    Text -> Ptr UserMessage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userMessageNew" Ptr UserMessage
result
    UserMessage
result' <- ((ManagedPtr UserMessage -> UserMessage)
-> Ptr UserMessage -> IO UserMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr UserMessage -> UserMessage
UserMessage) Ptr UserMessage
result
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
parameters GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    UserMessage -> IO UserMessage
forall (m :: * -> *) a. Monad m => a -> m a
return UserMessage
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method UserMessage::new_with_fd_list
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameters"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message parameters as a #GVariant"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd_list"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixFDList" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the message file descriptors"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "UserMessage" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_message_new_with_fd_list" webkit_user_message_new_with_fd_list :: 
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- parameters : TVariant
    Ptr Gio.UnixFDList.UnixFDList ->        -- fd_list : TInterface (Name {namespace = "Gio", name = "UnixFDList"})
    IO (Ptr UserMessage)

-- | Create a new t'GI.WebKit2.Objects.UserMessage.UserMessage' including also a list of UNIX file descriptors to be sent.
-- 
-- /Since: 2.28/
userMessageNewWithFdList ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.UnixFDList.IsUnixFDList a) =>
    T.Text
    -- ^ /@name@/: the message name
    -> Maybe (GVariant)
    -- ^ /@parameters@/: the message parameters as a t'GVariant'
    -> Maybe (a)
    -- ^ /@fdList@/: the message file descriptors
    -> m UserMessage
    -- ^ __Returns:__ the newly created t'GI.WebKit2.Objects.UserMessage.UserMessage' object.
userMessageNewWithFdList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUnixFDList a) =>
Text -> Maybe GVariant -> Maybe a -> m UserMessage
userMessageNewWithFdList Text
name Maybe GVariant
parameters Maybe a
fdList = IO UserMessage -> m UserMessage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UserMessage -> m UserMessage)
-> IO UserMessage -> m UserMessage
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
maybeParameters <- case Maybe GVariant
parameters of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just GVariant
jParameters -> do
            Ptr GVariant
jParameters' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jParameters
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jParameters'
    Ptr UnixFDList
maybeFdList <- case Maybe a
fdList of
        Maybe a
Nothing -> Ptr UnixFDList -> IO (Ptr UnixFDList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr UnixFDList
forall a. Ptr a
nullPtr
        Just a
jFdList -> do
            Ptr UnixFDList
jFdList' <- a -> IO (Ptr UnixFDList)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jFdList
            Ptr UnixFDList -> IO (Ptr UnixFDList)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr UnixFDList
jFdList'
    Ptr UserMessage
result <- CString -> Ptr GVariant -> Ptr UnixFDList -> IO (Ptr UserMessage)
webkit_user_message_new_with_fd_list CString
name' Ptr GVariant
maybeParameters Ptr UnixFDList
maybeFdList
    Text -> Ptr UserMessage -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userMessageNewWithFdList" Ptr UserMessage
result
    UserMessage
result' <- ((ManagedPtr UserMessage -> UserMessage)
-> Ptr UserMessage -> IO UserMessage
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr UserMessage -> UserMessage
UserMessage) Ptr UserMessage
result
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
parameters GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
fdList a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    UserMessage -> IO UserMessage
forall (m :: * -> *) a. Monad m => a -> m a
return UserMessage
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "webkit_user_message_get_fd_list" webkit_user_message_get_fd_list :: 
    Ptr UserMessage ->                      -- message : TInterface (Name {namespace = "WebKit2", name = "UserMessage"})
    IO (Ptr Gio.UnixFDList.UnixFDList)

-- | Get the /@message@/ list of file descritpor
-- 
-- /Since: 2.28/
userMessageGetFdList ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserMessage a) =>
    a
    -- ^ /@message@/: a t'GI.WebKit2.Objects.UserMessage.UserMessage'
    -> m Gio.UnixFDList.UnixFDList
    -- ^ __Returns:__ the message list of file descriptors
userMessageGetFdList :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUserMessage a) =>
a -> m UnixFDList
userMessageGetFdList a
message = IO UnixFDList -> m UnixFDList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixFDList -> m UnixFDList) -> IO UnixFDList -> m UnixFDList
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserMessage
message' <- a -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
message
    Ptr UnixFDList
result <- Ptr UserMessage -> IO (Ptr UnixFDList)
webkit_user_message_get_fd_list Ptr UserMessage
message'
    Text -> Ptr UnixFDList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userMessageGetFdList" Ptr UnixFDList
result
    UnixFDList
result' <- ((ManagedPtr UnixFDList -> UnixFDList)
-> Ptr UnixFDList -> IO UnixFDList
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr UnixFDList -> UnixFDList
Gio.UnixFDList.UnixFDList) Ptr UnixFDList
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
message
    UnixFDList -> IO UnixFDList
forall (m :: * -> *) a. Monad m => a -> m a
return UnixFDList
result'

#if defined(ENABLE_OVERLOADING)
data UserMessageGetFdListMethodInfo
instance (signature ~ (m Gio.UnixFDList.UnixFDList), MonadIO m, IsUserMessage a) => O.OverloadedMethod UserMessageGetFdListMethodInfo a signature where
    overloadedMethod = userMessageGetFdList

instance O.OverloadedMethodInfo UserMessageGetFdListMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserMessage.userMessageGetFdList",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserMessage.html#v:userMessageGetFdList"
        }


#endif

-- method UserMessage::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "UserMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserMessage"
--                 , 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_user_message_get_name" webkit_user_message_get_name :: 
    Ptr UserMessage ->                      -- message : TInterface (Name {namespace = "WebKit2", name = "UserMessage"})
    IO CString

-- | Get the /@message@/ name
-- 
-- /Since: 2.28/
userMessageGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserMessage a) =>
    a
    -- ^ /@message@/: a t'GI.WebKit2.Objects.UserMessage.UserMessage'
    -> m T.Text
    -- ^ __Returns:__ the message name
userMessageGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUserMessage a) =>
a -> m Text
userMessageGetName a
message = 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 UserMessage
message' <- a -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
message
    CString
result <- Ptr UserMessage -> IO CString
webkit_user_message_get_name Ptr UserMessage
message'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userMessageGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
message
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UserMessageGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsUserMessage a) => O.OverloadedMethod UserMessageGetNameMethodInfo a signature where
    overloadedMethod = userMessageGetName

instance O.OverloadedMethodInfo UserMessageGetNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserMessage.userMessageGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserMessage.html#v:userMessageGetName"
        }


#endif

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

foreign import ccall "webkit_user_message_get_parameters" webkit_user_message_get_parameters :: 
    Ptr UserMessage ->                      -- message : TInterface (Name {namespace = "WebKit2", name = "UserMessage"})
    IO (Ptr GVariant)

-- | Get the /@message@/ parameters
-- 
-- /Since: 2.28/
userMessageGetParameters ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserMessage a) =>
    a
    -- ^ /@message@/: a t'GI.WebKit2.Objects.UserMessage.UserMessage'
    -> m GVariant
    -- ^ __Returns:__ the message parameters
userMessageGetParameters :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsUserMessage a) =>
a -> m GVariant
userMessageGetParameters a
message = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr UserMessage
message' <- a -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
message
    Ptr GVariant
result <- Ptr UserMessage -> IO (Ptr GVariant)
webkit_user_message_get_parameters Ptr UserMessage
message'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"userMessageGetParameters" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
message
    GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data UserMessageGetParametersMethodInfo
instance (signature ~ (m GVariant), MonadIO m, IsUserMessage a) => O.OverloadedMethod UserMessageGetParametersMethodInfo a signature where
    overloadedMethod = userMessageGetParameters

instance O.OverloadedMethodInfo UserMessageGetParametersMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserMessage.userMessageGetParameters",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserMessage.html#v:userMessageGetParameters"
        }


#endif

-- method UserMessage::send_reply
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "message"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "UserMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserMessage"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reply"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "UserMessage" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitUserMessage to send as reply"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_user_message_send_reply" webkit_user_message_send_reply :: 
    Ptr UserMessage ->                      -- message : TInterface (Name {namespace = "WebKit2", name = "UserMessage"})
    Ptr UserMessage ->                      -- reply : TInterface (Name {namespace = "WebKit2", name = "UserMessage"})
    IO ()

-- | Send a reply to /@message@/. If /@reply@/ is floating, it\'s consumed.
-- You can only send a reply to a t'GI.WebKit2.Objects.UserMessage.UserMessage' that has been
-- received.
-- 
-- /Since: 2.28/
userMessageSendReply ::
    (B.CallStack.HasCallStack, MonadIO m, IsUserMessage a, IsUserMessage b) =>
    a
    -- ^ /@message@/: a t'GI.WebKit2.Objects.UserMessage.UserMessage'
    -> b
    -- ^ /@reply@/: a t'GI.WebKit2.Objects.UserMessage.UserMessage' to send as reply
    -> m ()
userMessageSendReply :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsUserMessage a, IsUserMessage b) =>
a -> b -> m ()
userMessageSendReply a
message b
reply = 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 UserMessage
message' <- a -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
message
    Ptr UserMessage
reply' <- b -> IO (Ptr UserMessage)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
reply
    Ptr UserMessage -> Ptr UserMessage -> IO ()
webkit_user_message_send_reply Ptr UserMessage
message' Ptr UserMessage
reply'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
message
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
reply
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UserMessageSendReplyMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsUserMessage a, IsUserMessage b) => O.OverloadedMethod UserMessageSendReplyMethodInfo a signature where
    overloadedMethod = userMessageSendReply

instance O.OverloadedMethodInfo UserMessageSendReplyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.UserMessage.userMessageSendReply",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-UserMessage.html#v:userMessageSendReply"
        }


#endif