{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Dazzle.Objects.ShortcutTheme
    ( 
#if defined(ENABLE_OVERLOADING)
    ShortcutThemeAddCommandMethodInfo       ,
#endif

-- * Exported types
    ShortcutTheme(..)                       ,
    IsShortcutTheme                         ,
    toShortcutTheme                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addCommand]("GI.Dazzle.Objects.ShortcutTheme#g:method:addCommand"), [addContext]("GI.Dazzle.Objects.ShortcutTheme#g:method:addContext"), [addCssResource]("GI.Dazzle.Objects.ShortcutTheme#g:method:addCssResource"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [findContextByName]("GI.Dazzle.Objects.ShortcutTheme#g:method:findContextByName"), [findDefaultContext]("GI.Dazzle.Objects.ShortcutTheme#g:method:findDefaultContext"), [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"), [loadFromData]("GI.Dazzle.Objects.ShortcutTheme#g:method:loadFromData"), [loadFromFile]("GI.Dazzle.Objects.ShortcutTheme#g:method:loadFromFile"), [loadFromPath]("GI.Dazzle.Objects.ShortcutTheme#g:method:loadFromPath"), [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"), [removeCssResource]("GI.Dazzle.Objects.ShortcutTheme#g:method:removeCssResource"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [saveToFile]("GI.Dazzle.Objects.ShortcutTheme#g:method:saveToFile"), [saveToPath]("GI.Dazzle.Objects.ShortcutTheme#g:method:saveToPath"), [saveToStream]("GI.Dazzle.Objects.ShortcutTheme#g:method:saveToStream"), [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
-- [getChordForAction]("GI.Dazzle.Objects.ShortcutTheme#g:method:getChordForAction"), [getChordForCommand]("GI.Dazzle.Objects.ShortcutTheme#g:method:getChordForCommand"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getName]("GI.Dazzle.Objects.ShortcutTheme#g:method:getName"), [getParent]("GI.Dazzle.Objects.ShortcutTheme#g:method:getParent"), [getParentName]("GI.Dazzle.Objects.ShortcutTheme#g:method:getParentName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSubtitle]("GI.Dazzle.Objects.ShortcutTheme#g:method:getSubtitle"), [getTitle]("GI.Dazzle.Objects.ShortcutTheme#g:method:getTitle").
-- 
-- ==== Setters
-- [setAccelForAction]("GI.Dazzle.Objects.ShortcutTheme#g:method:setAccelForAction"), [setAccelForCommand]("GI.Dazzle.Objects.ShortcutTheme#g:method:setAccelForCommand"), [setChordForAction]("GI.Dazzle.Objects.ShortcutTheme#g:method:setChordForAction"), [setChordForCommand]("GI.Dazzle.Objects.ShortcutTheme#g:method:setChordForCommand"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setParentName]("GI.Dazzle.Objects.ShortcutTheme#g:method:setParentName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutThemeMethod              ,
#endif

-- ** addContext #method:addContext#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeAddContextMethodInfo       ,
#endif
    shortcutThemeAddContext                 ,


-- ** addCssResource #method:addCssResource#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeAddCssResourceMethodInfo   ,
#endif
    shortcutThemeAddCssResource             ,


-- ** findContextByName #method:findContextByName#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeFindContextByNameMethodInfo,
#endif
    shortcutThemeFindContextByName          ,


-- ** findDefaultContext #method:findDefaultContext#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeFindDefaultContextMethodInfo,
#endif
    shortcutThemeFindDefaultContext         ,


-- ** getChordForAction #method:getChordForAction#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetChordForActionMethodInfo,
#endif
    shortcutThemeGetChordForAction          ,


-- ** getChordForCommand #method:getChordForCommand#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetChordForCommandMethodInfo,
#endif
    shortcutThemeGetChordForCommand         ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetNameMethodInfo          ,
#endif
    shortcutThemeGetName                    ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetParentMethodInfo        ,
#endif
    shortcutThemeGetParent                  ,


-- ** getParentName #method:getParentName#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetParentNameMethodInfo    ,
#endif
    shortcutThemeGetParentName              ,


-- ** getSubtitle #method:getSubtitle#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetSubtitleMethodInfo      ,
#endif
    shortcutThemeGetSubtitle                ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeGetTitleMethodInfo         ,
#endif
    shortcutThemeGetTitle                   ,


-- ** loadFromData #method:loadFromData#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeLoadFromDataMethodInfo     ,
#endif
    shortcutThemeLoadFromData               ,


-- ** loadFromFile #method:loadFromFile#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeLoadFromFileMethodInfo     ,
#endif
    shortcutThemeLoadFromFile               ,


-- ** loadFromPath #method:loadFromPath#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeLoadFromPathMethodInfo     ,
#endif
    shortcutThemeLoadFromPath               ,


-- ** new #method:new#

    shortcutThemeNew                        ,


-- ** removeCssResource #method:removeCssResource#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeRemoveCssResourceMethodInfo,
#endif
    shortcutThemeRemoveCssResource          ,


-- ** saveToFile #method:saveToFile#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSaveToFileMethodInfo       ,
#endif
    shortcutThemeSaveToFile                 ,


-- ** saveToPath #method:saveToPath#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSaveToPathMethodInfo       ,
#endif
    shortcutThemeSaveToPath                 ,


-- ** saveToStream #method:saveToStream#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSaveToStreamMethodInfo     ,
#endif
    shortcutThemeSaveToStream               ,


-- ** setAccelForAction #method:setAccelForAction#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSetAccelForActionMethodInfo,
#endif
    shortcutThemeSetAccelForAction          ,


-- ** setAccelForCommand #method:setAccelForCommand#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSetAccelForCommandMethodInfo,
#endif
    shortcutThemeSetAccelForCommand         ,


-- ** setChordForAction #method:setChordForAction#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSetChordForActionMethodInfo,
#endif
    shortcutThemeSetChordForAction          ,


-- ** setChordForCommand #method:setChordForCommand#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSetChordForCommandMethodInfo,
#endif
    shortcutThemeSetChordForCommand         ,


-- ** setParentName #method:setParentName#

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSetParentNameMethodInfo    ,
#endif
    shortcutThemeSetParentName              ,




 -- * Properties


-- ** name #attr:name#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeNamePropertyInfo           ,
#endif
    constructShortcutThemeName              ,
    getShortcutThemeName                    ,
#if defined(ENABLE_OVERLOADING)
    shortcutThemeName                       ,
#endif


-- ** parentName #attr:parentName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeParentNamePropertyInfo     ,
#endif
    constructShortcutThemeParentName        ,
    getShortcutThemeParentName              ,
    setShortcutThemeParentName              ,
#if defined(ENABLE_OVERLOADING)
    shortcutThemeParentName                 ,
#endif


-- ** subtitle #attr:subtitle#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeSubtitlePropertyInfo       ,
#endif
    clearShortcutThemeSubtitle              ,
    constructShortcutThemeSubtitle          ,
    getShortcutThemeSubtitle                ,
    setShortcutThemeSubtitle                ,
#if defined(ENABLE_OVERLOADING)
    shortcutThemeSubtitle                   ,
#endif


-- ** title #attr:title#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ShortcutThemeTitlePropertyInfo          ,
#endif
    clearShortcutThemeTitle                 ,
    constructShortcutThemeTitle             ,
    getShortcutThemeTitle                   ,
    setShortcutThemeTitle                   ,
#if defined(ENABLE_OVERLOADING)
    shortcutThemeTitle                      ,
#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.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 {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutContext as Dazzle.ShortcutContext
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags
import {-# SOURCE #-} qualified GI.Dazzle.Objects.ShortcutContext as Dazzle.ShortcutContext
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.OutputStream as Gio.OutputStream
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_shortcut_theme_get_type"
    c_dzl_shortcut_theme_get_type :: IO B.Types.GType

instance B.Types.TypedObject ShortcutTheme where
    glibType :: IO GType
glibType = IO GType
c_dzl_shortcut_theme_get_type

instance B.Types.GObject ShortcutTheme

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutThemeMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutThemeMethod "addCommand" o = ShortcutThemeAddCommandMethodInfo
    ResolveShortcutThemeMethod "addContext" o = ShortcutThemeAddContextMethodInfo
    ResolveShortcutThemeMethod "addCssResource" o = ShortcutThemeAddCssResourceMethodInfo
    ResolveShortcutThemeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveShortcutThemeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveShortcutThemeMethod "findContextByName" o = ShortcutThemeFindContextByNameMethodInfo
    ResolveShortcutThemeMethod "findDefaultContext" o = ShortcutThemeFindDefaultContextMethodInfo
    ResolveShortcutThemeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveShortcutThemeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveShortcutThemeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveShortcutThemeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveShortcutThemeMethod "loadFromData" o = ShortcutThemeLoadFromDataMethodInfo
    ResolveShortcutThemeMethod "loadFromFile" o = ShortcutThemeLoadFromFileMethodInfo
    ResolveShortcutThemeMethod "loadFromPath" o = ShortcutThemeLoadFromPathMethodInfo
    ResolveShortcutThemeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveShortcutThemeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveShortcutThemeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveShortcutThemeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveShortcutThemeMethod "removeCssResource" o = ShortcutThemeRemoveCssResourceMethodInfo
    ResolveShortcutThemeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveShortcutThemeMethod "saveToFile" o = ShortcutThemeSaveToFileMethodInfo
    ResolveShortcutThemeMethod "saveToPath" o = ShortcutThemeSaveToPathMethodInfo
    ResolveShortcutThemeMethod "saveToStream" o = ShortcutThemeSaveToStreamMethodInfo
    ResolveShortcutThemeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveShortcutThemeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveShortcutThemeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveShortcutThemeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveShortcutThemeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveShortcutThemeMethod "getChordForAction" o = ShortcutThemeGetChordForActionMethodInfo
    ResolveShortcutThemeMethod "getChordForCommand" o = ShortcutThemeGetChordForCommandMethodInfo
    ResolveShortcutThemeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveShortcutThemeMethod "getName" o = ShortcutThemeGetNameMethodInfo
    ResolveShortcutThemeMethod "getParent" o = ShortcutThemeGetParentMethodInfo
    ResolveShortcutThemeMethod "getParentName" o = ShortcutThemeGetParentNameMethodInfo
    ResolveShortcutThemeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveShortcutThemeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveShortcutThemeMethod "getSubtitle" o = ShortcutThemeGetSubtitleMethodInfo
    ResolveShortcutThemeMethod "getTitle" o = ShortcutThemeGetTitleMethodInfo
    ResolveShortcutThemeMethod "setAccelForAction" o = ShortcutThemeSetAccelForActionMethodInfo
    ResolveShortcutThemeMethod "setAccelForCommand" o = ShortcutThemeSetAccelForCommandMethodInfo
    ResolveShortcutThemeMethod "setChordForAction" o = ShortcutThemeSetChordForActionMethodInfo
    ResolveShortcutThemeMethod "setChordForCommand" o = ShortcutThemeSetChordForCommandMethodInfo
    ResolveShortcutThemeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveShortcutThemeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveShortcutThemeMethod "setParentName" o = ShortcutThemeSetParentNameMethodInfo
    ResolveShortcutThemeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveShortcutThemeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#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' shortcutTheme #name
-- @
getShortcutThemeName :: (MonadIO m, IsShortcutTheme o) => o -> m T.Text
getShortcutThemeName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> m Text
getShortcutThemeName o
obj = IO Text -> m Text
forall a. IO a -> m a
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
"getShortcutThemeName" (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`.
constructShortcutThemeName :: (IsShortcutTheme o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructShortcutThemeName :: forall o (m :: * -> *).
(IsShortcutTheme o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructShortcutThemeName Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
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 a. IO a -> IO a
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 ShortcutThemeNamePropertyInfo
instance AttrInfo ShortcutThemeNamePropertyInfo where
    type AttrAllowedOps ShortcutThemeNamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutThemeNamePropertyInfo = IsShortcutTheme
    type AttrSetTypeConstraint ShortcutThemeNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutThemeNamePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutThemeNamePropertyInfo = T.Text
    type AttrGetType ShortcutThemeNamePropertyInfo = T.Text
    type AttrLabel ShortcutThemeNamePropertyInfo = "name"
    type AttrOrigin ShortcutThemeNamePropertyInfo = ShortcutTheme
    attrGet = getShortcutThemeName
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutThemeName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.name"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:name"
        })
#endif

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

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

-- | Set the value of the “@parent-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutTheme [ #parentName 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutThemeParentName :: (MonadIO m, IsShortcutTheme o) => o -> T.Text -> m ()
setShortcutThemeParentName :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> Text -> m ()
setShortcutThemeParentName o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"parent-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeParentNamePropertyInfo
instance AttrInfo ShortcutThemeParentNamePropertyInfo where
    type AttrAllowedOps ShortcutThemeParentNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ShortcutThemeParentNamePropertyInfo = IsShortcutTheme
    type AttrSetTypeConstraint ShortcutThemeParentNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutThemeParentNamePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutThemeParentNamePropertyInfo = T.Text
    type AttrGetType ShortcutThemeParentNamePropertyInfo = (Maybe T.Text)
    type AttrLabel ShortcutThemeParentNamePropertyInfo = "parent-name"
    type AttrOrigin ShortcutThemeParentNamePropertyInfo = ShortcutTheme
    attrGet = getShortcutThemeParentName
    attrSet = setShortcutThemeParentName
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutThemeParentName
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.parentName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:parentName"
        })
#endif

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

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

-- | Set the value of the “@subtitle@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutTheme [ #subtitle 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutThemeSubtitle :: (MonadIO m, IsShortcutTheme o) => o -> T.Text -> m ()
setShortcutThemeSubtitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> Text -> m ()
setShortcutThemeSubtitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"subtitle" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@subtitle@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #subtitle
-- @
clearShortcutThemeSubtitle :: (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeSubtitle :: forall (m :: * -> *) o. (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeSubtitle o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"subtitle" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSubtitlePropertyInfo
instance AttrInfo ShortcutThemeSubtitlePropertyInfo where
    type AttrAllowedOps ShortcutThemeSubtitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutThemeSubtitlePropertyInfo = IsShortcutTheme
    type AttrSetTypeConstraint ShortcutThemeSubtitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutThemeSubtitlePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutThemeSubtitlePropertyInfo = T.Text
    type AttrGetType ShortcutThemeSubtitlePropertyInfo = T.Text
    type AttrLabel ShortcutThemeSubtitlePropertyInfo = "subtitle"
    type AttrOrigin ShortcutThemeSubtitlePropertyInfo = ShortcutTheme
    attrGet = getShortcutThemeSubtitle
    attrSet = setShortcutThemeSubtitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutThemeSubtitle
    attrClear = clearShortcutThemeSubtitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.subtitle"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:subtitle"
        })
#endif

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

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

-- | Set the value of the “@title@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutTheme [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutThemeTitle :: (MonadIO m, IsShortcutTheme o) => o -> T.Text -> m ()
setShortcutThemeTitle :: forall (m :: * -> *) o.
(MonadIO m, IsShortcutTheme o) =>
o -> Text -> m ()
setShortcutThemeTitle o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@title@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #title
-- @
clearShortcutThemeTitle :: (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeTitle :: forall (m :: * -> *) o. (MonadIO m, IsShortcutTheme o) => o -> m ()
clearShortcutThemeTitle o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"title" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeTitlePropertyInfo
instance AttrInfo ShortcutThemeTitlePropertyInfo where
    type AttrAllowedOps ShortcutThemeTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ShortcutThemeTitlePropertyInfo = IsShortcutTheme
    type AttrSetTypeConstraint ShortcutThemeTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ShortcutThemeTitlePropertyInfo = (~) T.Text
    type AttrTransferType ShortcutThemeTitlePropertyInfo = T.Text
    type AttrGetType ShortcutThemeTitlePropertyInfo = T.Text
    type AttrLabel ShortcutThemeTitlePropertyInfo = "title"
    type AttrOrigin ShortcutThemeTitlePropertyInfo = ShortcutTheme
    attrGet = getShortcutThemeTitle
    attrSet = setShortcutThemeTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructShortcutThemeTitle
    attrClear = clearShortcutThemeTitle
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutTheme
type instance O.AttributeList ShortcutTheme = ShortcutThemeAttributeList
type ShortcutThemeAttributeList = ('[ '("name", ShortcutThemeNamePropertyInfo), '("parentName", ShortcutThemeParentNamePropertyInfo), '("subtitle", ShortcutThemeSubtitlePropertyInfo), '("title", ShortcutThemeTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
shortcutThemeName :: AttrLabelProxy "name"
shortcutThemeName = AttrLabelProxy

shortcutThemeParentName :: AttrLabelProxy "parentName"
shortcutThemeParentName = AttrLabelProxy

shortcutThemeSubtitle :: AttrLabelProxy "subtitle"
shortcutThemeSubtitle = AttrLabelProxy

shortcutThemeTitle :: AttrLabelProxy "title"
shortcutThemeTitle = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "dzl_shortcut_theme_new" dzl_shortcut_theme_new :: 
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr ShortcutTheme)

-- | /No description available in the introspection data./
shortcutThemeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m ShortcutTheme
shortcutThemeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m ShortcutTheme
shortcutThemeNew Text
name = IO ShortcutTheme -> m ShortcutTheme
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutTheme -> m ShortcutTheme)
-> IO ShortcutTheme -> m ShortcutTheme
forall a b. (a -> b) -> a -> b
$ do
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr ShortcutTheme
result <- CString -> IO (Ptr ShortcutTheme)
dzl_shortcut_theme_new CString
name'
    Text -> Ptr ShortcutTheme -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeNew" Ptr ShortcutTheme
result
    ShortcutTheme
result' <- ((ManagedPtr ShortcutTheme -> ShortcutTheme)
-> Ptr ShortcutTheme -> IO ShortcutTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ShortcutTheme -> ShortcutTheme
ShortcutTheme) Ptr ShortcutTheme
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    ShortcutTheme -> IO ShortcutTheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutTheme
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- XXX Could not generate method ShortcutTheme::add_command
-- Bad introspection data: Could not resolve the symbol “dzl_shortcut_theme_add_command” in the “Dazzle” namespace, ignoring.
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data ShortcutThemeAddCommandMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "addCommand" ShortcutTheme) => O.OverloadedMethod ShortcutThemeAddCommandMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "addCommand" ShortcutTheme) => O.OverloadedMethodInfo ShortcutThemeAddCommandMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method ShortcutTheme::add_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_add_context" dzl_shortcut_theme_add_context :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    Ptr Dazzle.ShortcutContext.ShortcutContext -> -- context : TInterface (Name {namespace = "Dazzle", name = "ShortcutContext"})
    IO ()

-- | /No description available in the introspection data./
shortcutThemeAddContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Dazzle.ShortcutContext.IsShortcutContext b) =>
    a
    -> b
    -> m ()
shortcutThemeAddContext :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a,
 IsShortcutContext b) =>
a -> b -> m ()
shortcutThemeAddContext a
self b
context = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutContext
context' <- b -> IO (Ptr ShortcutContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr ShortcutTheme -> Ptr ShortcutContext -> IO ()
dzl_shortcut_theme_add_context Ptr ShortcutTheme
self' Ptr ShortcutContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeAddContextMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsShortcutTheme a, Dazzle.ShortcutContext.IsShortcutContext b) => O.OverloadedMethod ShortcutThemeAddContextMethodInfo a signature where
    overloadedMethod = shortcutThemeAddContext

instance O.OverloadedMethodInfo ShortcutThemeAddContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeAddContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeAddContext"
        })


#endif

-- method ShortcutTheme::add_css_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_add_css_resource" dzl_shortcut_theme_add_css_resource :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutThemeAddCssResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> m ()
shortcutThemeAddCssResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ()
shortcutThemeAddCssResource a
self Text
path = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr ShortcutTheme -> CString -> IO ()
dzl_shortcut_theme_add_css_resource Ptr ShortcutTheme
self' CString
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeAddCssResourceMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeAddCssResourceMethodInfo a signature where
    overloadedMethod = shortcutThemeAddCssResource

instance O.OverloadedMethodInfo ShortcutThemeAddCssResourceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeAddCssResource",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeAddCssResource"
        })


#endif

-- method ShortcutTheme::find_context_by_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #DzlShortcutContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The name of the context"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutContext" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_find_context_by_name" dzl_shortcut_theme_find_context_by_name :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Dazzle.ShortcutContext.ShortcutContext)

-- | Gets the context named /@name@/. If the context does not exist, it will
-- be created.
shortcutThemeFindContextByName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -- ^ /@self@/: An t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext'
    -> T.Text
    -- ^ /@name@/: The name of the context
    -> m Dazzle.ShortcutContext.ShortcutContext
    -- ^ __Returns:__ An t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext'
shortcutThemeFindContextByName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ShortcutContext
shortcutThemeFindContextByName a
self Text
name = IO ShortcutContext -> m ShortcutContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutContext -> m ShortcutContext)
-> IO ShortcutContext -> m ShortcutContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr ShortcutContext
result <- Ptr ShortcutTheme -> CString -> IO (Ptr ShortcutContext)
dzl_shortcut_theme_find_context_by_name Ptr ShortcutTheme
self' CString
name'
    Text -> Ptr ShortcutContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeFindContextByName" Ptr ShortcutContext
result
    ShortcutContext
result' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutContext -> ShortcutContext
Dazzle.ShortcutContext.ShortcutContext) Ptr ShortcutContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeFindContextByNameMethodInfo
instance (signature ~ (T.Text -> m Dazzle.ShortcutContext.ShortcutContext), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeFindContextByNameMethodInfo a signature where
    overloadedMethod = shortcutThemeFindContextByName

instance O.OverloadedMethodInfo ShortcutThemeFindContextByNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeFindContextByName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeFindContextByName"
        })


#endif

-- method ShortcutTheme::find_default_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "ShortcutContext" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_find_default_context" dzl_shortcut_theme_find_default_context :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    IO (Ptr Dazzle.ShortcutContext.ShortcutContext)

-- | Finds the default context in the theme for /@widget@/.
shortcutThemeFindDefaultContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gtk.Widget.IsWidget b) =>
    a
    -> b
    -> m (Maybe Dazzle.ShortcutContext.ShortcutContext)
    -- ^ __Returns:__ An t'GI.Dazzle.Objects.ShortcutContext.ShortcutContext' or 'P.Nothing'.
shortcutThemeFindDefaultContext :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsWidget b) =>
a -> b -> m (Maybe ShortcutContext)
shortcutThemeFindDefaultContext a
self b
widget = IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext))
-> IO (Maybe ShortcutContext) -> m (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    Ptr ShortcutContext
result <- Ptr ShortcutTheme -> Ptr Widget -> IO (Ptr ShortcutContext)
dzl_shortcut_theme_find_default_context Ptr ShortcutTheme
self' Ptr Widget
widget'
    Maybe ShortcutContext
maybeResult <- Ptr ShortcutContext
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutContext
result ((Ptr ShortcutContext -> IO ShortcutContext)
 -> IO (Maybe ShortcutContext))
-> (Ptr ShortcutContext -> IO ShortcutContext)
-> IO (Maybe ShortcutContext)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutContext
result' -> do
        ShortcutContext
result'' <- ((ManagedPtr ShortcutContext -> ShortcutContext)
-> Ptr ShortcutContext -> IO ShortcutContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutContext -> ShortcutContext
Dazzle.ShortcutContext.ShortcutContext) Ptr ShortcutContext
result'
        ShortcutContext -> IO ShortcutContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutContext
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    Maybe ShortcutContext -> IO (Maybe ShortcutContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutContext
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeFindDefaultContextMethodInfo
instance (signature ~ (b -> m (Maybe Dazzle.ShortcutContext.ShortcutContext)), MonadIO m, IsShortcutTheme a, Gtk.Widget.IsWidget b) => O.OverloadedMethod ShortcutThemeFindDefaultContextMethodInfo a signature where
    overloadedMethod = shortcutThemeFindDefaultContext

instance O.OverloadedMethodInfo ShortcutThemeFindDefaultContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeFindDefaultContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeFindDefaultContext"
        })


#endif

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

foreign import ccall "dzl_shortcut_theme_get_chord_for_action" dzl_shortcut_theme_get_chord_for_action :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- detailed_action_name : TBasicType TUTF8
    IO (Ptr Dazzle.ShortcutChord.ShortcutChord)

-- | /No description available in the introspection data./
shortcutThemeGetChordForAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> m Dazzle.ShortcutChord.ShortcutChord
shortcutThemeGetChordForAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ShortcutChord
shortcutThemeGetChordForAction a
self Text
detailedActionName = IO ShortcutChord -> m ShortcutChord
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutChord -> m ShortcutChord)
-> IO ShortcutChord -> m ShortcutChord
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
    Ptr ShortcutChord
result <- Ptr ShortcutTheme -> CString -> IO (Ptr ShortcutChord)
dzl_shortcut_theme_get_chord_for_action Ptr ShortcutTheme
self' CString
detailedActionName'
    Text -> Ptr ShortcutChord -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetChordForAction" Ptr ShortcutChord
result
    ShortcutChord
result' <- ((ManagedPtr ShortcutChord -> ShortcutChord)
-> Ptr ShortcutChord -> IO ShortcutChord
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ShortcutChord -> ShortcutChord
Dazzle.ShortcutChord.ShortcutChord) Ptr ShortcutChord
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
    ShortcutChord -> IO ShortcutChord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutChord
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetChordForActionMethodInfo
instance (signature ~ (T.Text -> m Dazzle.ShortcutChord.ShortcutChord), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetChordForActionMethodInfo a signature where
    overloadedMethod = shortcutThemeGetChordForAction

instance O.OverloadedMethodInfo ShortcutThemeGetChordForActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetChordForAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetChordForAction"
        })


#endif

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

foreign import ccall "dzl_shortcut_theme_get_chord_for_command" dzl_shortcut_theme_get_chord_for_command :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- command : TBasicType TUTF8
    IO (Ptr Dazzle.ShortcutChord.ShortcutChord)

-- | /No description available in the introspection data./
shortcutThemeGetChordForCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> m Dazzle.ShortcutChord.ShortcutChord
shortcutThemeGetChordForCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ShortcutChord
shortcutThemeGetChordForCommand a
self Text
command = IO ShortcutChord -> m ShortcutChord
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutChord -> m ShortcutChord)
-> IO ShortcutChord -> m ShortcutChord
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
command' <- Text -> IO CString
textToCString Text
command
    Ptr ShortcutChord
result <- Ptr ShortcutTheme -> CString -> IO (Ptr ShortcutChord)
dzl_shortcut_theme_get_chord_for_command Ptr ShortcutTheme
self' CString
command'
    Text -> Ptr ShortcutChord -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetChordForCommand" Ptr ShortcutChord
result
    ShortcutChord
result' <- ((ManagedPtr ShortcutChord -> ShortcutChord)
-> Ptr ShortcutChord -> IO ShortcutChord
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr ShortcutChord -> ShortcutChord
Dazzle.ShortcutChord.ShortcutChord) Ptr ShortcutChord
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
command'
    ShortcutChord -> IO ShortcutChord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutChord
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetChordForCommandMethodInfo
instance (signature ~ (T.Text -> m Dazzle.ShortcutChord.ShortcutChord), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetChordForCommandMethodInfo a signature where
    overloadedMethod = shortcutThemeGetChordForCommand

instance O.OverloadedMethodInfo ShortcutThemeGetChordForCommandMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetChordForCommand",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetChordForCommand"
        })


#endif

-- method ShortcutTheme::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_get_name" dzl_shortcut_theme_get_name :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    IO CString

-- | /No description available in the introspection data./
shortcutThemeGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> m T.Text
shortcutThemeGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m Text
shortcutThemeGetName 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_name Ptr ShortcutTheme
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText 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 ShortcutThemeGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetNameMethodInfo a signature where
    overloadedMethod = shortcutThemeGetName

instance O.OverloadedMethodInfo ShortcutThemeGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetName"
        })


#endif

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

foreign import ccall "dzl_shortcut_theme_get_parent" dzl_shortcut_theme_get_parent :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    IO (Ptr ShortcutTheme)

-- | If the [ShortcutTheme:parentName]("GI.Dazzle.Objects.ShortcutTheme#g:attr:parentName") property has been set, this will fetch
-- the parent t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'.
shortcutThemeGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'
    -> m (Maybe ShortcutTheme)
    -- ^ __Returns:__ A t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme' or 'P.Nothing'.
shortcutThemeGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m (Maybe ShortcutTheme)
shortcutThemeGetParent a
self = IO (Maybe ShortcutTheme) -> m (Maybe ShortcutTheme)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ShortcutTheme) -> m (Maybe ShortcutTheme))
-> IO (Maybe ShortcutTheme) -> m (Maybe ShortcutTheme)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ShortcutTheme
result <- Ptr ShortcutTheme -> IO (Ptr ShortcutTheme)
dzl_shortcut_theme_get_parent Ptr ShortcutTheme
self'
    Maybe ShortcutTheme
maybeResult <- Ptr ShortcutTheme
-> (Ptr ShortcutTheme -> IO ShortcutTheme)
-> IO (Maybe ShortcutTheme)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ShortcutTheme
result ((Ptr ShortcutTheme -> IO ShortcutTheme)
 -> IO (Maybe ShortcutTheme))
-> (Ptr ShortcutTheme -> IO ShortcutTheme)
-> IO (Maybe ShortcutTheme)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutTheme
result' -> do
        ShortcutTheme
result'' <- ((ManagedPtr ShortcutTheme -> ShortcutTheme)
-> Ptr ShortcutTheme -> IO ShortcutTheme
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ShortcutTheme -> ShortcutTheme
ShortcutTheme) Ptr ShortcutTheme
result'
        ShortcutTheme -> IO ShortcutTheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutTheme
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ShortcutTheme -> IO (Maybe ShortcutTheme)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ShortcutTheme
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetParentMethodInfo
instance (signature ~ (m (Maybe ShortcutTheme)), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetParentMethodInfo a signature where
    overloadedMethod = shortcutThemeGetParent

instance O.OverloadedMethodInfo ShortcutThemeGetParentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetParent"
        })


#endif

-- method ShortcutTheme::get_parent_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTheme"
--                 , 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 "dzl_shortcut_theme_get_parent_name" dzl_shortcut_theme_get_parent_name :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    IO CString

-- | Gets the name of the parent shortcut theme.
-- 
-- This is used to resolve shortcuts from the parent theme without having to
-- copy them directly into this shortcut theme. It allows for some level of
-- copy-on-write (CoW).
shortcutThemeGetParentName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The name of the parent theme, or 'P.Nothing' if none is set.
shortcutThemeGetParentName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m (Maybe Text)
shortcutThemeGetParentName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_parent_name Ptr ShortcutTheme
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeGetParentNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetParentNameMethodInfo a signature where
    overloadedMethod = shortcutThemeGetParentName

instance O.OverloadedMethodInfo ShortcutThemeGetParentNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetParentName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetParentName"
        })


#endif

-- method ShortcutTheme::get_subtitle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_get_subtitle" dzl_shortcut_theme_get_subtitle :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    IO CString

-- | /No description available in the introspection data./
shortcutThemeGetSubtitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> m T.Text
shortcutThemeGetSubtitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m Text
shortcutThemeGetSubtitle 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_subtitle Ptr ShortcutTheme
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetSubtitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText 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 ShortcutThemeGetSubtitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetSubtitleMethodInfo a signature where
    overloadedMethod = shortcutThemeGetSubtitle

instance O.OverloadedMethodInfo ShortcutThemeGetSubtitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetSubtitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetSubtitle"
        })


#endif

-- method ShortcutTheme::get_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_get_title" dzl_shortcut_theme_get_title :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    IO CString

-- | /No description available in the introspection data./
shortcutThemeGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> m T.Text
shortcutThemeGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> m Text
shortcutThemeGetTitle 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr ShortcutTheme -> IO CString
dzl_shortcut_theme_get_title Ptr ShortcutTheme
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutThemeGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText 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 ShortcutThemeGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeGetTitleMethodInfo a signature where
    overloadedMethod = shortcutThemeGetTitle

instance O.OverloadedMethodInfo ShortcutThemeGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeGetTitle"
        })


#endif

-- method ShortcutTheme::load_from_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TSSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_load_from_data" dzl_shortcut_theme_load_from_data :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- data : TBasicType TUTF8
    DI.Int64 ->                             -- len : TBasicType TSSize
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutThemeLoadFromData ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> DI.Int64
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutThemeLoadFromData :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> Int64 -> m ()
shortcutThemeLoadFromData a
self Text
data_ Int64
len = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
data_' <- Text -> IO CString
textToCString Text
data_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> CString -> Int64 -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_load_from_data Ptr ShortcutTheme
self' CString
data_' Int64
len
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeLoadFromDataMethodInfo
instance (signature ~ (T.Text -> DI.Int64 -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeLoadFromDataMethodInfo a signature where
    overloadedMethod = shortcutThemeLoadFromData

instance O.OverloadedMethodInfo ShortcutThemeLoadFromDataMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeLoadFromData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeLoadFromData"
        })


#endif

-- method ShortcutTheme::load_from_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_load_from_file" dzl_shortcut_theme_load_from_file :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutThemeLoadFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutThemeLoadFromFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsFile b,
 IsCancellable c) =>
a -> b -> Maybe c -> m ()
shortcutThemeLoadFromFile a
self b
file Maybe c
cancellable = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_load_from_file Ptr ShortcutTheme
self' Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeLoadFromFileMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ShortcutThemeLoadFromFileMethodInfo a signature where
    overloadedMethod = shortcutThemeLoadFromFile

instance O.OverloadedMethodInfo ShortcutThemeLoadFromFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeLoadFromFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeLoadFromFile"
        })


#endif

-- method ShortcutTheme::load_from_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_load_from_path" dzl_shortcut_theme_load_from_path :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutThemeLoadFromPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) =>
    a
    -> T.Text
    -> Maybe (b)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutThemeLoadFromPath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
shortcutThemeLoadFromPath a
self Text
path Maybe b
cancellable = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_load_from_path Ptr ShortcutTheme
self' CString
path' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeLoadFromPathMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ShortcutThemeLoadFromPathMethodInfo a signature where
    overloadedMethod = shortcutThemeLoadFromPath

instance O.OverloadedMethodInfo ShortcutThemeLoadFromPathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeLoadFromPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeLoadFromPath"
        })


#endif

-- method ShortcutTheme::remove_css_resource
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_remove_css_resource" dzl_shortcut_theme_remove_css_resource :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- path : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutThemeRemoveCssResource ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> m ()
shortcutThemeRemoveCssResource :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ()
shortcutThemeRemoveCssResource a
self Text
path = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr ShortcutTheme -> CString -> IO ()
dzl_shortcut_theme_remove_css_resource Ptr ShortcutTheme
self' CString
path'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeRemoveCssResourceMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeRemoveCssResourceMethodInfo a signature where
    overloadedMethod = shortcutThemeRemoveCssResource

instance O.OverloadedMethodInfo ShortcutThemeRemoveCssResourceMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeRemoveCssResource",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeRemoveCssResource"
        })


#endif

-- method ShortcutTheme::save_to_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_save_to_file" dzl_shortcut_theme_save_to_file :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutThemeSaveToFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutThemeSaveToFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsFile b,
 IsCancellable c) =>
a -> b -> Maybe c -> m ()
shortcutThemeSaveToFile a
self b
file Maybe c
cancellable = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_save_to_file Ptr ShortcutTheme
self' Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSaveToFileMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsShortcutTheme a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ShortcutThemeSaveToFileMethodInfo a signature where
    overloadedMethod = shortcutThemeSaveToFile

instance O.OverloadedMethodInfo ShortcutThemeSaveToFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSaveToFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSaveToFile"
        })


#endif

-- method ShortcutTheme::save_to_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_save_to_path" dzl_shortcut_theme_save_to_path :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutThemeSaveToPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) =>
    a
    -> T.Text
    -> Maybe (b)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutThemeSaveToPath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
shortcutThemeSaveToPath a
self Text
path Maybe b
cancellable = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_shortcut_theme_save_to_path Ptr ShortcutTheme
self' CString
path' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSaveToPathMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsShortcutTheme a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod ShortcutThemeSaveToPathMethodInfo a signature where
    overloadedMethod = shortcutThemeSaveToPath

instance O.OverloadedMethodInfo ShortcutThemeSaveToPathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSaveToPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSaveToPath"
        })


#endif

-- method ShortcutTheme::save_to_stream
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "OutputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "dzl_shortcut_theme_save_to_stream" dzl_shortcut_theme_save_to_stream :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    Ptr Gio.OutputStream.OutputStream ->    -- stream : TInterface (Name {namespace = "Gio", name = "OutputStream"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
shortcutThemeSaveToStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a, Gio.OutputStream.IsOutputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
shortcutThemeSaveToStream :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsShortcutTheme a, IsOutputStream b,
 IsCancellable c) =>
a -> b -> Maybe c -> m ()
shortcutThemeSaveToStream a
self b
stream Maybe c
cancellable = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr OutputStream
stream' <- b -> IO (Ptr OutputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
stream
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr ShortcutTheme
-> Ptr OutputStream
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
dzl_shortcut_theme_save_to_stream Ptr ShortcutTheme
self' Ptr OutputStream
stream' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
stream
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSaveToStreamMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsShortcutTheme a, Gio.OutputStream.IsOutputStream b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod ShortcutThemeSaveToStreamMethodInfo a signature where
    overloadedMethod = shortcutThemeSaveToStream

instance O.OverloadedMethodInfo ShortcutThemeSaveToStreamMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSaveToStream",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSaveToStream"
        })


#endif

-- method ShortcutTheme::set_accel_for_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_set_accel_for_action" dzl_shortcut_theme_set_accel_for_action :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- detailed_action_name : TBasicType TUTF8
    CString ->                              -- accel : TBasicType TUTF8
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    IO ()

-- | /No description available in the introspection data./
shortcutThemeSetAccelForAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> T.Text
    -> [Dazzle.Flags.ShortcutPhase]
    -> m ()
shortcutThemeSetAccelForAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> Text -> [ShortcutPhase] -> m ()
shortcutThemeSetAccelForAction a
self Text
detailedActionName Text
accel [ShortcutPhase]
phase = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
    CString
accel' <- Text -> IO CString
textToCString Text
accel
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    Ptr ShortcutTheme -> CString -> CString -> CUInt -> IO ()
dzl_shortcut_theme_set_accel_for_action Ptr ShortcutTheme
self' CString
detailedActionName' CString
accel' CUInt
phase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
accel'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetAccelForActionMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetAccelForActionMethodInfo a signature where
    overloadedMethod = shortcutThemeSetAccelForAction

instance O.OverloadedMethodInfo ShortcutThemeSetAccelForActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetAccelForAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetAccelForAction"
        })


#endif

-- method ShortcutTheme::set_accel_for_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTheme"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the command to be executed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accel"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the shortcut accelerator"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the phase to activate within, or 0 for the default"
--                 , 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 "dzl_shortcut_theme_set_accel_for_command" dzl_shortcut_theme_set_accel_for_command :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- command : TBasicType TUTF8
    CString ->                              -- accel : TBasicType TUTF8
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    IO ()

-- | This will set the command to execute when /@accel@/ is pressed.  If command is
-- 'P.Nothing', the accelerator will be cleared.  If accelerator is 'P.Nothing', all
-- accelerators for /@command@/ will be cleared.
shortcutThemeSetAccelForCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'
    -> Maybe (T.Text)
    -- ^ /@command@/: the command to be executed
    -> Maybe (T.Text)
    -- ^ /@accel@/: the shortcut accelerator
    -> [Dazzle.Flags.ShortcutPhase]
    -- ^ /@phase@/: the phase to activate within, or 0 for the default
    -> m ()
shortcutThemeSetAccelForCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Maybe Text -> Maybe Text -> [ShortcutPhase] -> m ()
shortcutThemeSetAccelForCommand a
self Maybe Text
command Maybe Text
accel [ShortcutPhase]
phase = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeCommand <- case Maybe Text
command of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCommand -> do
            CString
jCommand' <- Text -> IO CString
textToCString Text
jCommand
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCommand'
    CString
maybeAccel <- case Maybe Text
accel of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jAccel -> do
            CString
jAccel' <- Text -> IO CString
textToCString Text
jAccel
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jAccel'
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    Ptr ShortcutTheme -> CString -> CString -> CUInt -> IO ()
dzl_shortcut_theme_set_accel_for_command Ptr ShortcutTheme
self' CString
maybeCommand CString
maybeAccel CUInt
phase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCommand
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAccel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetAccelForCommandMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetAccelForCommandMethodInfo a signature where
    overloadedMethod = shortcutThemeSetAccelForCommand

instance O.OverloadedMethodInfo ShortcutThemeSetAccelForCommandMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetAccelForCommand",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetAccelForCommand"
        })


#endif

-- method ShortcutTheme::set_chord_for_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "detailed_action_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chord"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutChord" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_set_chord_for_action" dzl_shortcut_theme_set_chord_for_action :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- detailed_action_name : TBasicType TUTF8
    Ptr Dazzle.ShortcutChord.ShortcutChord -> -- chord : TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    IO ()

-- | /No description available in the introspection data./
shortcutThemeSetChordForAction ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> Dazzle.ShortcutChord.ShortcutChord
    -> [Dazzle.Flags.ShortcutPhase]
    -> m ()
shortcutThemeSetChordForAction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> ShortcutChord -> [ShortcutPhase] -> m ()
shortcutThemeSetChordForAction a
self Text
detailedActionName ShortcutChord
chord [ShortcutPhase]
phase = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
detailedActionName' <- Text -> IO CString
textToCString Text
detailedActionName
    Ptr ShortcutChord
chord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
chord
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    Ptr ShortcutTheme -> CString -> Ptr ShortcutChord -> CUInt -> IO ()
dzl_shortcut_theme_set_chord_for_action Ptr ShortcutTheme
self' CString
detailedActionName' Ptr ShortcutChord
chord' CUInt
phase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChord
chord
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
detailedActionName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetChordForActionMethodInfo
instance (signature ~ (T.Text -> Dazzle.ShortcutChord.ShortcutChord -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetChordForActionMethodInfo a signature where
    overloadedMethod = shortcutThemeSetChordForAction

instance O.OverloadedMethodInfo ShortcutThemeSetChordForActionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetChordForAction",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetChordForAction"
        })


#endif

-- method ShortcutTheme::set_chord_for_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutTheme"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the command to be executed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chord"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutChord" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the chord for the command"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "phase"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutPhase" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the phase to activate within, or 0 for the default"
--                 , 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 "dzl_shortcut_theme_set_chord_for_command" dzl_shortcut_theme_set_chord_for_command :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- command : TBasicType TUTF8
    Ptr Dazzle.ShortcutChord.ShortcutChord -> -- chord : TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
    CUInt ->                                -- phase : TInterface (Name {namespace = "Dazzle", name = "ShortcutPhase"})
    IO ()

-- | This will set the command to execute when /@chord@/ is pressed.  If command is
-- 'P.Nothing', the accelerator will be cleared.  If /@chord@/ is 'P.Nothing', all
-- accelerators for /@command@/ will be cleared.
shortcutThemeSetChordForCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -- ^ /@self@/: a t'GI.Dazzle.Objects.ShortcutTheme.ShortcutTheme'
    -> Maybe (T.Text)
    -- ^ /@command@/: the command to be executed
    -> Maybe (Dazzle.ShortcutChord.ShortcutChord)
    -- ^ /@chord@/: the chord for the command
    -> [Dazzle.Flags.ShortcutPhase]
    -- ^ /@phase@/: the phase to activate within, or 0 for the default
    -> m ()
shortcutThemeSetChordForCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Maybe Text -> Maybe ShortcutChord -> [ShortcutPhase] -> m ()
shortcutThemeSetChordForCommand a
self Maybe Text
command Maybe ShortcutChord
chord [ShortcutPhase]
phase = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeCommand <- case Maybe Text
command of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jCommand -> do
            CString
jCommand' <- Text -> IO CString
textToCString Text
jCommand
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCommand'
    Ptr ShortcutChord
maybeChord <- case Maybe ShortcutChord
chord of
        Maybe ShortcutChord
Nothing -> Ptr ShortcutChord -> IO (Ptr ShortcutChord)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutChord
forall a. Ptr a
nullPtr
        Just ShortcutChord
jChord -> do
            Ptr ShortcutChord
jChord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
jChord
            Ptr ShortcutChord -> IO (Ptr ShortcutChord)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ShortcutChord
jChord'
    let phase' :: CUInt
phase' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
phase
    Ptr ShortcutTheme -> CString -> Ptr ShortcutChord -> CUInt -> IO ()
dzl_shortcut_theme_set_chord_for_command Ptr ShortcutTheme
self' CString
maybeCommand Ptr ShortcutChord
maybeChord CUInt
phase'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ShortcutChord -> (ShortcutChord -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ShortcutChord
chord ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCommand
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetChordForCommandMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (Dazzle.ShortcutChord.ShortcutChord) -> [Dazzle.Flags.ShortcutPhase] -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetChordForCommandMethodInfo a signature where
    overloadedMethod = shortcutThemeSetChordForCommand

instance O.OverloadedMethodInfo ShortcutThemeSetChordForCommandMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetChordForCommand",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetChordForCommand"
        })


#endif

-- method ShortcutTheme::set_parent_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "ShortcutTheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_shortcut_theme_set_parent_name" dzl_shortcut_theme_set_parent_name :: 
    Ptr ShortcutTheme ->                    -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutTheme"})
    CString ->                              -- parent_name : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
shortcutThemeSetParentName ::
    (B.CallStack.HasCallStack, MonadIO m, IsShortcutTheme a) =>
    a
    -> T.Text
    -> m ()
shortcutThemeSetParentName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsShortcutTheme a) =>
a -> Text -> m ()
shortcutThemeSetParentName a
self Text
parentName = 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 ShortcutTheme
self' <- a -> IO (Ptr ShortcutTheme)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
parentName' <- Text -> IO CString
textToCString Text
parentName
    Ptr ShortcutTheme -> CString -> IO ()
dzl_shortcut_theme_set_parent_name Ptr ShortcutTheme
self' CString
parentName'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
parentName'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutThemeSetParentNameMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsShortcutTheme a) => O.OverloadedMethod ShortcutThemeSetParentNameMethodInfo a signature where
    overloadedMethod = shortcutThemeSetParentName

instance O.OverloadedMethodInfo ShortcutThemeSetParentNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.ShortcutTheme.shortcutThemeSetParentName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-ShortcutTheme.html#v:shortcutThemeSetParentName"
        })


#endif