{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkShortcutAction@ encodes an action that can be triggered by a
-- keyboard shortcut.
-- 
-- @GtkShortcutActions@ contain functions that allow easy presentation
-- to end users as well as being printed for debugging.
-- 
-- All @GtkShortcutActions@ are immutable, you can only specify their
-- properties during construction. If you want to change a action, you
-- have to replace it with a new one. If you need to pass arguments to
-- an action, these are specified by the higher-level @GtkShortcut@ object.
-- 
-- To activate a @GtkShortcutAction@ manually, 'GI.Gtk.Objects.ShortcutAction.shortcutActionActivate'
-- can be called.
-- 
-- GTK provides various actions:
-- 
--  - t'GI.Gtk.Objects.MnemonicAction.MnemonicAction': a shortcut action that calls
--    'GI.Gtk.Objects.Widget.widgetMnemonicActivate'
--  - t'GI.Gtk.Objects.CallbackAction.CallbackAction': a shortcut action that invokes
--    a given callback
--  - t'GI.Gtk.Objects.SignalAction.SignalAction': a shortcut action that emits a
--    given signal
--  - t'GI.Gtk.Objects.ActivateAction.ActivateAction': a shortcut action that calls
--    'GI.Gtk.Objects.Widget.widgetActivate'
--  - t'GI.Gtk.Objects.NamedAction.NamedAction': a shortcut action that calls
--    @/gtk_widget_activate_action()/@
--  - t'GI.Gtk.Objects.NothingAction.NothingAction': a shortcut action that does nothing

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

module GI.Gtk.Objects.ShortcutAction
    ( 

-- * Exported types
    ShortcutAction(..)                      ,
    IsShortcutAction                        ,
    toShortcutAction                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activate]("GI.Gtk.Objects.ShortcutAction#g:method:activate"), [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"), [print]("GI.Gtk.Objects.ShortcutAction#g:method:print"), [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"), [toString]("GI.Gtk.Objects.ShortcutAction#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [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)
    ResolveShortcutActionMethod             ,
#endif

-- ** activate #method:activate#

#if defined(ENABLE_OVERLOADING)
    ShortcutActionActivateMethodInfo        ,
#endif
    shortcutActionActivate                  ,


-- ** parseString #method:parseString#

    shortcutActionParseString               ,


-- ** print #method:print#

#if defined(ENABLE_OVERLOADING)
    ShortcutActionPrintMethodInfo           ,
#endif
    shortcutActionPrint                     ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    ShortcutActionToStringMethodInfo        ,
#endif
    shortcutActionToString                  ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Objects.Renderer as Gsk.Renderer
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.Path as Gsk.Path
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Stroke as Gsk.Stroke
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Snapshot as Gtk.Snapshot
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout

#else
import qualified GI.GLib.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "gtk_shortcut_action_get_type"
    c_gtk_shortcut_action_get_type :: IO B.Types.GType

instance B.Types.TypedObject ShortcutAction where
    glibType :: IO GType
glibType = IO GType
c_gtk_shortcut_action_get_type

instance B.Types.GObject ShortcutAction

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutActionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutActionMethod "activate" o = ShortcutActionActivateMethodInfo
    ResolveShortcutActionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutActionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutActionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutActionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutActionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutActionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutActionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutActionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutActionMethod "print" o = ShortcutActionPrintMethodInfo
    ResolveShortcutActionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutActionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutActionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutActionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutActionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutActionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutActionMethod "toString" o = ShortcutActionToStringMethodInfo
    ResolveShortcutActionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutActionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutActionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutActionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutActionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutActionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutActionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutActionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutActionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "gtk_shortcut_action_parse_string" gtk_shortcut_action_parse_string :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr ShortcutAction)

-- | Tries to parse the given string into an action.
-- 
-- On success, the parsed action is returned. When parsing
-- failed, 'P.Nothing' is returned.
-- 
-- The accepted strings are:
-- 
-- * @nothing@, for @GtkNothingAction@
-- * @activate@, for @GtkActivateAction@
-- * @mnemonic-activate@, for @GtkMnemonicAction@
-- * @action(NAME)@, for a @GtkNamedAction@ for the action named @NAME@
-- * @signal(NAME)@, for a @GtkSignalAction@ for the signal @NAME@
shortcutActionParseString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: the string to parse
    -> m (Maybe ShortcutAction)
    -- ^ __Returns:__ a new @GtkShortcutAction@
shortcutActionParseString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe ShortcutAction)
shortcutActionParseString Text
string = IO (Maybe ShortcutAction) -> m (Maybe ShortcutAction)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutAction) -> m (Maybe ShortcutAction))
-> IO (Maybe ShortcutAction) -> m (Maybe ShortcutAction)
forall a b. (a -> b) -> a -> b
$ do
    CString
string' <- Text -> IO CString
textToCString Text
string
    Ptr ShortcutAction
result <- CString -> IO (Ptr ShortcutAction)
gtk_shortcut_action_parse_string CString
string'
    Maybe ShortcutAction
maybeResult <- Ptr ShortcutAction
-> (Ptr ShortcutAction -> IO ShortcutAction)
-> IO (Maybe ShortcutAction)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutAction
result ((Ptr ShortcutAction -> IO ShortcutAction)
 -> IO (Maybe ShortcutAction))
-> (Ptr ShortcutAction -> IO ShortcutAction)
-> IO (Maybe ShortcutAction)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutAction
result' -> do
        ShortcutAction
result'' <- ((ManagedPtr ShortcutAction -> ShortcutAction)
-> Ptr ShortcutAction -> IO ShortcutAction
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ShortcutAction -> ShortcutAction
ShortcutAction) Ptr ShortcutAction
result'
        ShortcutAction -> IO ShortcutAction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutAction
result''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
string'
    Maybe ShortcutAction -> IO (Maybe ShortcutAction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutAction
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method ShortcutAction::activate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ShortcutAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkShortcutAction`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "ShortcutActionFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags to activate with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Target of the activation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "args"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "arguments to pass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_shortcut_action_activate" gtk_shortcut_action_activate :: 
    Ptr ShortcutAction ->                   -- self : TInterface (Name {namespace = "Gtk", name = "ShortcutAction"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gtk", name = "ShortcutActionFlags"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    Ptr GVariant ->                         -- args : TVariant
    IO CInt

-- | Activates the action on the /@widget@/ with the given /@args@/.
-- 
-- Note that some actions ignore the passed in /@flags@/, /@widget@/ or /@args@/.
-- 
-- Activation of an action can fail for various reasons. If the action
-- is not supported by the /@widget@/, if the /@args@/ don\'t match the action
-- or if the activation otherwise had no effect, 'P.False' will be returned.
shortcutActionActivate ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutAction a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a @GtkShortcutAction@
    -> [Gtk.Flags.ShortcutActionFlags]
    -- ^ /@flags@/: flags to activate with
    -> b
    -- ^ /@widget@/: Target of the activation
    -> Maybe (GVariant)
    -- ^ /@args@/: arguments to pass
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this action was activated successfully
shortcutActionActivate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutAction a, IsWidget b) =>
a -> [ShortcutActionFlags] -> b -> Maybe GVariant -> m Bool
shortcutActionActivate a
self [ShortcutActionFlags]
flags b
widget Maybe GVariant
args = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutAction
self' <- a -> IO (Ptr ShortcutAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let flags' :: CUInt
flags' = [ShortcutActionFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutActionFlags]
flags
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr GVariant
maybeArgs <- case Maybe GVariant
args 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
jArgs -> do
            Ptr GVariant
jArgs' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jArgs
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jArgs'
    CInt
result <- Ptr ShortcutAction
-> CUInt -> Ptr Widget -> Ptr GVariant -> IO CInt
gtk_shortcut_action_activate Ptr ShortcutAction
self' CUInt
flags' Ptr Widget
widget' Ptr GVariant
maybeArgs
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
args GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutActionActivateMethodInfo
instance (signature ~ ([Gtk.Flags.ShortcutActionFlags] -> b -> Maybe (GVariant) -> m Bool), MonadIO m, IsShortcutAction a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ShortcutActionActivateMethodInfo a signature where
    overloadedMethod = shortcutActionActivate

instance O.OverloadedMethodInfo ShortcutActionActivateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ShortcutAction.shortcutActionActivate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ShortcutAction.html#v:shortcutActionActivate"
        })


#endif

-- method ShortcutAction::print
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ShortcutAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkShortcutAction`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "string"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GString` to print into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_shortcut_action_print" gtk_shortcut_action_print :: 
    Ptr ShortcutAction ->                   -- self : TInterface (Name {namespace = "Gtk", name = "ShortcutAction"})
    Ptr GLib.String.String ->               -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO ()

-- | Prints the given action into a string for the developer.
-- 
-- This is meant for debugging and logging.
-- 
-- The form of the representation may change at any time and is
-- not guaranteed to stay identical.
shortcutActionPrint ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutAction a) =>
    a
    -- ^ /@self@/: a @GtkShortcutAction@
    -> GLib.String.String
    -- ^ /@string@/: a @GString@ to print into
    -> m ()
shortcutActionPrint :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutAction a) =>
a -> String -> m ()
shortcutActionPrint a
self String
string = 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 ShortcutAction
self' <- a -> IO (Ptr ShortcutAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr String
string' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
string
    Ptr ShortcutAction -> Ptr String -> IO ()
gtk_shortcut_action_print Ptr ShortcutAction
self' Ptr String
string'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
string
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutActionPrintMethodInfo
instance (signature ~ (GLib.String.String -> m ()), MonadIO m, IsShortcutAction a) => O.OverloadedMethod ShortcutActionPrintMethodInfo a signature where
    overloadedMethod = shortcutActionPrint

instance O.OverloadedMethodInfo ShortcutActionPrintMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ShortcutAction.shortcutActionPrint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ShortcutAction.html#v:shortcutActionPrint"
        })


#endif

-- method ShortcutAction::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ShortcutAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkShortcutAction`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_shortcut_action_to_string" gtk_shortcut_action_to_string :: 
    Ptr ShortcutAction ->                   -- self : TInterface (Name {namespace = "Gtk", name = "ShortcutAction"})
    IO CString

-- | Prints the given action into a human-readable string.
-- 
-- This is a small wrapper around 'GI.Gtk.Objects.ShortcutAction.shortcutActionPrint'
-- to help when debugging.
shortcutActionToString ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutAction a) =>
    a
    -- ^ /@self@/: a @GtkShortcutAction@
    -> m T.Text
    -- ^ __Returns:__ a new string
shortcutActionToString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutAction a) =>
a -> m Text
shortcutActionToString a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutAction
self' <- a -> IO (Ptr ShortcutAction)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutAction -> IO CString
gtk_shortcut_action_to_string Ptr ShortcutAction
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutActionToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutActionToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutAction a) => O.OverloadedMethod ShortcutActionToStringMethodInfo a signature where
    overloadedMethod = shortcutActionToString

instance O.OverloadedMethodInfo ShortcutActionToStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.ShortcutAction.shortcutActionToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.9/docs/GI-Gtk-Objects-ShortcutAction.html#v:shortcutActionToString"
        })


#endif