{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gtk.Objects.ShortcutAction.ShortcutAction' is the object used to describe what a t'GI.Gtk.Objects.Shortcut.Shortcut' should
-- do when triggered. To activate a t'GI.Gtk.Objects.ShortcutAction.ShortcutAction' manually,
-- 'GI.Gtk.Objects.ShortcutAction.shortcutActionActivate' can be called.
-- 
-- @/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 t'GI.Gtk.Objects.Shortcut.Shortcut' object.
-- 
-- 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
-- 
-- = GtkShortcutAction as GtkBuildable
-- 
-- GtkShortcut

#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
-- ** Overloaded methods #method:Overloaded methods#

#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.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 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

-- | 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
/= :: ShortcutAction -> ShortcutAction -> Bool
$c/= :: ShortcutAction -> ShortcutAction -> Bool
== :: ShortcutAction -> ShortcutAction -> Bool
$c== :: 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

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

-- | 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 :: (MonadIO m, IsShortcutAction o) => o -> m ShortcutAction
toShortcutAction :: o -> m ShortcutAction
toShortcutAction = IO ShortcutAction -> m ShortcutAction
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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'
unsafeCastTo ManagedPtr ShortcutAction -> ShortcutAction
ShortcutAction

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutActionMethod (t :: Symbol) (o :: *) :: * 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.MethodInfo 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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#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
--           , 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 t'GI.Gtk.Objects.NothingAction.NothingAction'
--   - @activate@, for t'GI.Gtk.Objects.ActivateAction.ActivateAction'
--   - @mnemonic-activate@, for t'GI.Gtk.Objects.MnemonicAction.MnemonicAction'
--   - @action(NAME)@, for a t'GI.Gtk.Objects.NamedAction.NamedAction' for the action named @NAME@
--   - @signal(NAME)@, for a t'GI.Gtk.Objects.SignalAction.SignalAction' for the signal @NAME@
shortcutActionParseString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: the string to parse
    -> m (Maybe ShortcutAction)
    -- ^ __Returns:__ a new t'GI.Gtk.Objects.ShortcutAction.ShortcutAction'
    --     or 'P.Nothing' on error
shortcutActionParseString :: Text -> m (Maybe ShortcutAction)
shortcutActionParseString Text
string = IO (Maybe ShortcutAction) -> m (Maybe ShortcutAction)
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 (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 (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
--           , 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
--           , 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
--           , 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
--           , 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 t'GI.Gtk.Objects.ShortcutAction.ShortcutAction'
    -> [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 :: a -> [ShortcutActionFlags] -> b -> Maybe GVariant -> m Bool
shortcutActionActivate a
self [ShortcutActionFlags]
flags b
widget Maybe GVariant
args = IO Bool -> m Bool
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 (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 (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 (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.MethodInfo ShortcutActionActivateMethodInfo a signature where
    overloadedMethod = 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
--           , 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
--           , 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 t'GI.Gtk.Objects.ShortcutAction.ShortcutAction'
    -> GLib.String.String
    -- ^ /@string@/: a t'GI.GLib.Structs.String.String' to print into
    -> m ()
shortcutActionPrint :: a -> String -> m ()
shortcutActionPrint a
self String
string = 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 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 (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.MethodInfo ShortcutActionPrintMethodInfo a signature where
    overloadedMethod = 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
--           , 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 t'GI.Gtk.Objects.ShortcutAction.ShortcutAction'
    -> m T.Text
    -- ^ __Returns:__ a new string
shortcutActionToString :: a -> m Text
shortcutActionToString a
self = 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 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 (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.MethodInfo ShortcutActionToStringMethodInfo a signature where
    overloadedMethod = shortcutActionToString

#endif