{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The GRemoteActionGroup interface is implemented by t'GI.Gio.Interfaces.ActionGroup.ActionGroup'
-- instances that either transmit action invocations to other processes
-- or receive action invocations in the local process from other
-- processes.
-- 
-- The interface has @_full@ variants of the two
-- methods on t'GI.Gio.Interfaces.ActionGroup.ActionGroup' used to activate actions:
-- 'GI.Gio.Interfaces.ActionGroup.actionGroupActivateAction' and
-- 'GI.Gio.Interfaces.ActionGroup.actionGroupChangeActionState'. These variants allow a
-- \"platform data\" t'GVariant' to be specified: a dictionary providing
-- context for the action invocation (for example: timestamps, startup
-- notification IDs, etc).
-- 
-- t'GI.Gio.Objects.DBusActionGroup.DBusActionGroup' implements t'GI.Gio.Interfaces.RemoteActionGroup.RemoteActionGroup'.  This provides a
-- mechanism to send platform data for action invocations over D-Bus.
-- 
-- Additionally, 'GI.Gio.Objects.DBusConnection.dBusConnectionExportActionGroup' will check if
-- the exported t'GI.Gio.Interfaces.ActionGroup.ActionGroup' implements t'GI.Gio.Interfaces.RemoteActionGroup.RemoteActionGroup' and use the
-- @_full@ variants of the calls if available.  This
-- provides a mechanism by which to receive platform data for action
-- invocations that arrive by way of D-Bus.
-- 
-- /Since: 2.32/

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

module GI.Gio.Interfaces.RemoteActionGroup
    ( 

-- * Exported types
    RemoteActionGroup(..)                   ,
    IsRemoteActionGroup                     ,
    toRemoteActionGroup                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionAdded]("GI.Gio.Interfaces.ActionGroup#g:method:actionAdded"), [actionEnabledChanged]("GI.Gio.Interfaces.ActionGroup#g:method:actionEnabledChanged"), [actionRemoved]("GI.Gio.Interfaces.ActionGroup#g:method:actionRemoved"), [actionStateChanged]("GI.Gio.Interfaces.ActionGroup#g:method:actionStateChanged"), [activateAction]("GI.Gio.Interfaces.ActionGroup#g:method:activateAction"), [activateActionFull]("GI.Gio.Interfaces.RemoteActionGroup#g:method:activateActionFull"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [changeActionState]("GI.Gio.Interfaces.ActionGroup#g:method:changeActionState"), [changeActionStateFull]("GI.Gio.Interfaces.RemoteActionGroup#g:method:changeActionStateFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasAction]("GI.Gio.Interfaces.ActionGroup#g:method:hasAction"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [listActions]("GI.Gio.Interfaces.ActionGroup#g:method:listActions"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [queryAction]("GI.Gio.Interfaces.ActionGroup#g:method:queryAction"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getActionEnabled]("GI.Gio.Interfaces.ActionGroup#g:method:getActionEnabled"), [getActionParameterType]("GI.Gio.Interfaces.ActionGroup#g:method:getActionParameterType"), [getActionState]("GI.Gio.Interfaces.ActionGroup#g:method:getActionState"), [getActionStateHint]("GI.Gio.Interfaces.ActionGroup#g:method:getActionStateHint"), [getActionStateType]("GI.Gio.Interfaces.ActionGroup#g:method:getActionStateType"), [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
-- [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)
    ResolveRemoteActionGroupMethod          ,
#endif

-- ** activateActionFull #method:activateActionFull#

#if defined(ENABLE_OVERLOADING)
    RemoteActionGroupActivateActionFullMethodInfo,
#endif
    remoteActionGroupActivateActionFull     ,


-- ** changeActionStateFull #method:changeActionStateFull#

#if defined(ENABLE_OVERLOADING)
    RemoteActionGroupChangeActionStateFullMethodInfo,
#endif
    remoteActionGroupChangeActionStateFull  ,




    ) 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.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup

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

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

foreign import ccall "g_remote_action_group_get_type"
    c_g_remote_action_group_get_type :: IO B.Types.GType

instance B.Types.TypedObject RemoteActionGroup where
    glibType :: IO GType
glibType = IO GType
c_g_remote_action_group_get_type

instance B.Types.GObject RemoteActionGroup

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

instance O.HasParentTypes RemoteActionGroup
type instance O.ParentTypes RemoteActionGroup = '[Gio.ActionGroup.ActionGroup, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RemoteActionGroup
type instance O.AttributeList RemoteActionGroup = RemoteActionGroupAttributeList
type RemoteActionGroupAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRemoteActionGroupMethod (t :: Symbol) (o :: *) :: * where
    ResolveRemoteActionGroupMethod "actionAdded" o = Gio.ActionGroup.ActionGroupActionAddedMethodInfo
    ResolveRemoteActionGroupMethod "actionEnabledChanged" o = Gio.ActionGroup.ActionGroupActionEnabledChangedMethodInfo
    ResolveRemoteActionGroupMethod "actionRemoved" o = Gio.ActionGroup.ActionGroupActionRemovedMethodInfo
    ResolveRemoteActionGroupMethod "actionStateChanged" o = Gio.ActionGroup.ActionGroupActionStateChangedMethodInfo
    ResolveRemoteActionGroupMethod "activateAction" o = Gio.ActionGroup.ActionGroupActivateActionMethodInfo
    ResolveRemoteActionGroupMethod "activateActionFull" o = RemoteActionGroupActivateActionFullMethodInfo
    ResolveRemoteActionGroupMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRemoteActionGroupMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRemoteActionGroupMethod "changeActionState" o = Gio.ActionGroup.ActionGroupChangeActionStateMethodInfo
    ResolveRemoteActionGroupMethod "changeActionStateFull" o = RemoteActionGroupChangeActionStateFullMethodInfo
    ResolveRemoteActionGroupMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRemoteActionGroupMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRemoteActionGroupMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRemoteActionGroupMethod "hasAction" o = Gio.ActionGroup.ActionGroupHasActionMethodInfo
    ResolveRemoteActionGroupMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRemoteActionGroupMethod "listActions" o = Gio.ActionGroup.ActionGroupListActionsMethodInfo
    ResolveRemoteActionGroupMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRemoteActionGroupMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRemoteActionGroupMethod "queryAction" o = Gio.ActionGroup.ActionGroupQueryActionMethodInfo
    ResolveRemoteActionGroupMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRemoteActionGroupMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRemoteActionGroupMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRemoteActionGroupMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRemoteActionGroupMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRemoteActionGroupMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRemoteActionGroupMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRemoteActionGroupMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRemoteActionGroupMethod "getActionEnabled" o = Gio.ActionGroup.ActionGroupGetActionEnabledMethodInfo
    ResolveRemoteActionGroupMethod "getActionParameterType" o = Gio.ActionGroup.ActionGroupGetActionParameterTypeMethodInfo
    ResolveRemoteActionGroupMethod "getActionState" o = Gio.ActionGroup.ActionGroupGetActionStateMethodInfo
    ResolveRemoteActionGroupMethod "getActionStateHint" o = Gio.ActionGroup.ActionGroupGetActionStateHintMethodInfo
    ResolveRemoteActionGroupMethod "getActionStateType" o = Gio.ActionGroup.ActionGroupGetActionStateTypeMethodInfo
    ResolveRemoteActionGroupMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRemoteActionGroupMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRemoteActionGroupMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRemoteActionGroupMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRemoteActionGroupMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRemoteActionGroupMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRemoteActionGroupMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method RemoteActionGroup::activate_action_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "RemoteActionGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GDBusActionGroup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action to activate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameter"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the optional parameter to the activation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "platform_data"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the platform data to send"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_remote_action_group_activate_action_full" g_remote_action_group_activate_action_full :: 
    Ptr RemoteActionGroup ->                -- remote : TInterface (Name {namespace = "Gio", name = "RemoteActionGroup"})
    CString ->                              -- action_name : TBasicType TUTF8
    Ptr GVariant ->                         -- parameter : TVariant
    Ptr GVariant ->                         -- platform_data : TVariant
    IO ()

-- | Activates the remote action.
-- 
-- This is the same as 'GI.Gio.Interfaces.ActionGroup.actionGroupActivateAction' except that it
-- allows for provision of \"platform data\" to be sent along with the
-- activation request.  This typically contains details such as the user
-- interaction timestamp or startup notification information.
-- 
-- /@platformData@/ must be non-'P.Nothing' and must have the type
-- @/G_VARIANT_TYPE_VARDICT/@.  If it is floating, it will be consumed.
-- 
-- /Since: 2.32/
remoteActionGroupActivateActionFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemoteActionGroup a) =>
    a
    -- ^ /@remote@/: a t'GI.Gio.Objects.DBusActionGroup.DBusActionGroup'
    -> T.Text
    -- ^ /@actionName@/: the name of the action to activate
    -> Maybe (GVariant)
    -- ^ /@parameter@/: the optional parameter to the activation
    -> GVariant
    -- ^ /@platformData@/: the platform data to send
    -> m ()
remoteActionGroupActivateActionFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteActionGroup a) =>
a -> Text -> Maybe GVariant -> GVariant -> m ()
remoteActionGroupActivateActionFull a
remote Text
actionName Maybe GVariant
parameter GVariant
platformData = 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 RemoteActionGroup
remote' <- a -> IO (Ptr RemoteActionGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    Ptr GVariant
maybeParameter <- case Maybe GVariant
parameter 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
jParameter -> do
            Ptr GVariant
jParameter' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jParameter
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jParameter'
    Ptr GVariant
platformData' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
platformData
    Ptr RemoteActionGroup
-> CString -> Ptr GVariant -> Ptr GVariant -> IO ()
g_remote_action_group_activate_action_full Ptr RemoteActionGroup
remote' CString
actionName' Ptr GVariant
maybeParameter Ptr GVariant
platformData'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
parameter GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
platformData
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo RemoteActionGroupActivateActionFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.RemoteActionGroup.remoteActionGroupActivateActionFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Interfaces-RemoteActionGroup.html#v:remoteActionGroupActivateActionFull"
        })


#endif

-- method RemoteActionGroup::change_action_state_full
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "remote"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "RemoteActionGroup" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRemoteActionGroup"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the action to change the state of"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new requested value for the state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "platform_data"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the platform data to send"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_remote_action_group_change_action_state_full" g_remote_action_group_change_action_state_full :: 
    Ptr RemoteActionGroup ->                -- remote : TInterface (Name {namespace = "Gio", name = "RemoteActionGroup"})
    CString ->                              -- action_name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    Ptr GVariant ->                         -- platform_data : TVariant
    IO ()

-- | Changes the state of a remote action.
-- 
-- This is the same as 'GI.Gio.Interfaces.ActionGroup.actionGroupChangeActionState' except that
-- it allows for provision of \"platform data\" to be sent along with the
-- state change request.  This typically contains details such as the
-- user interaction timestamp or startup notification information.
-- 
-- /@platformData@/ must be non-'P.Nothing' and must have the type
-- @/G_VARIANT_TYPE_VARDICT/@.  If it is floating, it will be consumed.
-- 
-- /Since: 2.32/
remoteActionGroupChangeActionStateFull ::
    (B.CallStack.HasCallStack, MonadIO m, IsRemoteActionGroup a) =>
    a
    -- ^ /@remote@/: a t'GI.Gio.Interfaces.RemoteActionGroup.RemoteActionGroup'
    -> T.Text
    -- ^ /@actionName@/: the name of the action to change the state of
    -> GVariant
    -- ^ /@value@/: the new requested value for the state
    -> GVariant
    -- ^ /@platformData@/: the platform data to send
    -> m ()
remoteActionGroupChangeActionStateFull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsRemoteActionGroup a) =>
a -> Text -> GVariant -> GVariant -> m ()
remoteActionGroupChangeActionStateFull a
remote Text
actionName GVariant
value GVariant
platformData = 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 RemoteActionGroup
remote' <- a -> IO (Ptr RemoteActionGroup)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
remote
    CString
actionName' <- Text -> IO CString
textToCString Text
actionName
    Ptr GVariant
value' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
value
    Ptr GVariant
platformData' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
platformData
    Ptr RemoteActionGroup
-> CString -> Ptr GVariant -> Ptr GVariant -> IO ()
g_remote_action_group_change_action_state_full Ptr RemoteActionGroup
remote' CString
actionName' Ptr GVariant
value' Ptr GVariant
platformData'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
remote
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
value
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
platformData
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
actionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RemoteActionGroupChangeActionStateFullMethodInfo
instance (signature ~ (T.Text -> GVariant -> GVariant -> m ()), MonadIO m, IsRemoteActionGroup a) => O.OverloadedMethod RemoteActionGroupChangeActionStateFullMethodInfo a signature where
    overloadedMethod = remoteActionGroupChangeActionStateFull

instance O.OverloadedMethodInfo RemoteActionGroupChangeActionStateFullMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.RemoteActionGroup.remoteActionGroupChangeActionStateFull",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Interfaces-RemoteActionGroup.html#v:remoteActionGroupChangeActionStateFull"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList RemoteActionGroup = RemoteActionGroupSignalList
type RemoteActionGroupSignalList = ('[ '("actionAdded", Gio.ActionGroup.ActionGroupActionAddedSignalInfo), '("actionEnabledChanged", Gio.ActionGroup.ActionGroupActionEnabledChangedSignalInfo), '("actionRemoved", Gio.ActionGroup.ActionGroupActionRemovedSignalInfo), '("actionStateChanged", Gio.ActionGroup.ActionGroupActionStateChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif