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

-- * Exported types
    ShortcutChordTable(..)                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [add]("GI.Dazzle.Structs.ShortcutChordTable#g:method:add"), [foreach]("GI.Dazzle.Structs.ShortcutChordTable#g:method:foreach"), [free]("GI.Dazzle.Structs.ShortcutChordTable#g:method:free"), [lookup]("GI.Dazzle.Structs.ShortcutChordTable#g:method:lookup"), [lookupData]("GI.Dazzle.Structs.ShortcutChordTable#g:method:lookupData"), [printf]("GI.Dazzle.Structs.ShortcutChordTable#g:method:printf"), [remove]("GI.Dazzle.Structs.ShortcutChordTable#g:method:remove"), [removeData]("GI.Dazzle.Structs.ShortcutChordTable#g:method:removeData"), [size]("GI.Dazzle.Structs.ShortcutChordTable#g:method:size").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- [setFreeFunc]("GI.Dazzle.Structs.ShortcutChordTable#g:method:setFreeFunc").

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutChordTableMethod         ,
#endif

-- ** add #method:add#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableAddMethodInfo         ,
#endif
    shortcutChordTableAdd                   ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableForeachMethodInfo     ,
#endif
    shortcutChordTableForeach               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableFreeMethodInfo        ,
#endif
    shortcutChordTableFree                  ,


-- ** lookup #method:lookup#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableLookupMethodInfo      ,
#endif
    shortcutChordTableLookup                ,


-- ** lookupData #method:lookupData#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableLookupDataMethodInfo  ,
#endif
    shortcutChordTableLookupData            ,


-- ** printf #method:printf#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTablePrintfMethodInfo      ,
#endif
    shortcutChordTablePrintf                ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableRemoveMethodInfo      ,
#endif
    shortcutChordTableRemove                ,


-- ** removeData #method:removeData#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableRemoveDataMethodInfo  ,
#endif
    shortcutChordTableRemoveData            ,


-- ** setFreeFunc #method:setFreeFunc#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableSetFreeFuncMethodInfo ,
#endif
    shortcutChordTableSetFreeFunc           ,


-- ** size #method:size#

#if defined(ENABLE_OVERLOADING)
    ShortcutChordTableSizeMethodInfo        ,
#endif
    shortcutChordTableSize                  ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey

#else
import qualified GI.Dazzle.Callbacks as Dazzle.Callbacks
import {-# SOURCE #-} qualified GI.Dazzle.Enums as Dazzle.Enums
import {-# SOURCE #-} qualified GI.Dazzle.Structs.ShortcutChord as Dazzle.ShortcutChord
import qualified GI.GLib.Callbacks as GLib.Callbacks

#endif

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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr ShortcutChordTable where
    boxedPtrCopy :: ShortcutChordTable -> IO ShortcutChordTable
boxedPtrCopy = ShortcutChordTable -> IO ShortcutChordTable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: ShortcutChordTable -> IO ()
boxedPtrFree = \ShortcutChordTable
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

-- method ShortcutChordTable::add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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 = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , 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_chord_table_add" dzl_shortcut_chord_table_add :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    Ptr Dazzle.ShortcutChord.ShortcutChord -> -- chord : TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO ()

-- | /No description available in the introspection data./
shortcutChordTableAdd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> Dazzle.ShortcutChord.ShortcutChord
    -> Ptr ()
    -> m ()
shortcutChordTableAdd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> ShortcutChord -> Ptr () -> m ()
shortcutChordTableAdd ShortcutChordTable
self ShortcutChord
chord Ptr ()
data_ = 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 ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr ShortcutChord
chord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
chord
    Ptr ShortcutChordTable -> Ptr ShortcutChord -> Ptr () -> IO ()
dzl_shortcut_chord_table_add Ptr ShortcutChordTable
self' Ptr ShortcutChord
chord' Ptr ()
data_
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChord
chord
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableAddMethodInfo
instance (signature ~ (Dazzle.ShortcutChord.ShortcutChord -> Ptr () -> m ()), MonadIO m) => O.OverloadedMethod ShortcutChordTableAddMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableAdd

instance O.OverloadedMethodInfo ShortcutChordTableAddMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableAdd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableAdd"
        })


#endif

-- method ShortcutChordTable::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #DzlShortcutChordTable"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "foreach_func"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTableForeach" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A callback for each chord"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "foreach_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @foreach_func"
--                 , 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_chord_table_foreach" dzl_shortcut_chord_table_foreach :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    FunPtr Dazzle.Callbacks.C_ShortcutChordTableForeach -> -- foreach_func : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTableForeach"})
    Ptr () ->                               -- foreach_data : TBasicType TPtr
    IO ()

-- | This function will call /@foreachFunc@/ for each chord in the table.
shortcutChordTableForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -- ^ /@self@/: a t'GI.Dazzle.Structs.ShortcutChordTable.ShortcutChordTable'
    -> Dazzle.Callbacks.ShortcutChordTableForeach
    -- ^ /@foreachFunc@/: A callback for each chord
    -> m ()
shortcutChordTableForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> ShortcutChordTableForeach -> m ()
shortcutChordTableForeach ShortcutChordTable
self ShortcutChordTableForeach
foreachFunc = 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 ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    FunPtr C_ShortcutChordTableForeach
foreachFunc' <- C_ShortcutChordTableForeach
-> IO (FunPtr C_ShortcutChordTableForeach)
Dazzle.Callbacks.mk_ShortcutChordTableForeach (Maybe (Ptr (FunPtr C_ShortcutChordTableForeach))
-> ShortcutChordTableForeach_WithClosures
-> C_ShortcutChordTableForeach
Dazzle.Callbacks.wrap_ShortcutChordTableForeach Maybe (Ptr (FunPtr C_ShortcutChordTableForeach))
forall a. Maybe a
Nothing (ShortcutChordTableForeach -> ShortcutChordTableForeach_WithClosures
Dazzle.Callbacks.drop_closures_ShortcutChordTableForeach ShortcutChordTableForeach
foreachFunc))
    let foreachData :: Ptr a
foreachData = Ptr a
forall a. Ptr a
nullPtr
    Ptr ShortcutChordTable
-> FunPtr C_ShortcutChordTableForeach -> Ptr () -> IO ()
dzl_shortcut_chord_table_foreach Ptr ShortcutChordTable
self' FunPtr C_ShortcutChordTableForeach
foreachFunc' Ptr ()
forall a. Ptr a
foreachData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ShortcutChordTableForeach -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ShortcutChordTableForeach
foreachFunc'
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableForeachMethodInfo
instance (signature ~ (Dazzle.Callbacks.ShortcutChordTableForeach -> m ()), MonadIO m) => O.OverloadedMethod ShortcutChordTableForeachMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableForeach

instance O.OverloadedMethodInfo ShortcutChordTableForeachMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableForeach"
        })


#endif

-- method ShortcutChordTable::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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_chord_table_free" dzl_shortcut_chord_table_free :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    IO ()

-- | /No description available in the introspection data./
shortcutChordTableFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> m ()
shortcutChordTableFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> m ()
shortcutChordTableFree ShortcutChordTable
self = 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 ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr ShortcutChordTable -> IO ()
dzl_shortcut_chord_table_free Ptr ShortcutChordTable
self'
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ShortcutChordTableFreeMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableFree

instance O.OverloadedMethodInfo ShortcutChordTableFreeMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableFree"
        })


#endif

-- method ShortcutChordTable::lookup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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 = "data"
--           , argType = TBasicType TPtr
--           , 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
--               (TInterface Name { namespace = "Dazzle" , name = "ShortcutMatch" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_chord_table_lookup" dzl_shortcut_chord_table_lookup :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    Ptr Dazzle.ShortcutChord.ShortcutChord -> -- chord : TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO CUInt

-- | /No description available in the introspection data./
shortcutChordTableLookup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> Dazzle.ShortcutChord.ShortcutChord
    -> Ptr ()
    -> m Dazzle.Enums.ShortcutMatch
shortcutChordTableLookup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> ShortcutChord -> Ptr () -> m ShortcutMatch
shortcutChordTableLookup ShortcutChordTable
self ShortcutChord
chord Ptr ()
data_ = IO ShortcutMatch -> m ShortcutMatch
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutMatch -> m ShortcutMatch)
-> IO ShortcutMatch -> m ShortcutMatch
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr ShortcutChord
chord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
chord
    CUInt
result <- Ptr ShortcutChordTable -> Ptr ShortcutChord -> Ptr () -> IO CUInt
dzl_shortcut_chord_table_lookup Ptr ShortcutChordTable
self' Ptr ShortcutChord
chord' Ptr ()
data_
    let result' :: ShortcutMatch
result' = (Int -> ShortcutMatch
forall a. Enum a => Int -> a
toEnum (Int -> ShortcutMatch) -> (CUInt -> Int) -> CUInt -> ShortcutMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChord
chord
    ShortcutMatch -> IO ShortcutMatch
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutMatch
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableLookupMethodInfo
instance (signature ~ (Dazzle.ShortcutChord.ShortcutChord -> Ptr () -> m Dazzle.Enums.ShortcutMatch), MonadIO m) => O.OverloadedMethod ShortcutChordTableLookupMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableLookup

instance O.OverloadedMethodInfo ShortcutChordTableLookupMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableLookup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableLookup"
        })


#endif

-- method ShortcutChordTable::lookup_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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 TPtr
--           , 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
--               (TInterface Name { namespace = "Dazzle" , name = "ShortcutChord" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_chord_table_lookup_data" dzl_shortcut_chord_table_lookup_data :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO (Ptr Dazzle.ShortcutChord.ShortcutChord)

-- | /No description available in the introspection data./
shortcutChordTableLookupData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> Ptr ()
    -> m Dazzle.ShortcutChord.ShortcutChord
shortcutChordTableLookupData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> Ptr () -> m ShortcutChord
shortcutChordTableLookupData ShortcutChordTable
self Ptr ()
data_ = 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 ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr ShortcutChord
result <- Ptr ShortcutChordTable -> Ptr () -> IO (Ptr ShortcutChord)
dzl_shortcut_chord_table_lookup_data Ptr ShortcutChordTable
self' Ptr ()
data_
    Text -> Ptr ShortcutChord -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"shortcutChordTableLookupData" 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
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    ShortcutChord -> IO ShortcutChord
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutChord
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableLookupDataMethodInfo
instance (signature ~ (Ptr () -> m Dazzle.ShortcutChord.ShortcutChord), MonadIO m) => O.OverloadedMethod ShortcutChordTableLookupDataMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableLookupData

instance O.OverloadedMethodInfo ShortcutChordTableLookupDataMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableLookupData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableLookupData"
        })


#endif

-- method ShortcutChordTable::printf
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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_chord_table_printf" dzl_shortcut_chord_table_printf :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    IO ()

-- | /No description available in the introspection data./
shortcutChordTablePrintf ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> m ()
shortcutChordTablePrintf :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> m ()
shortcutChordTablePrintf ShortcutChordTable
self = 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 ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr ShortcutChordTable -> IO ()
dzl_shortcut_chord_table_printf Ptr ShortcutChordTable
self'
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTablePrintfMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ShortcutChordTablePrintfMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTablePrintf

instance O.OverloadedMethodInfo ShortcutChordTablePrintfMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTablePrintf",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTablePrintf"
        })


#endif

-- method ShortcutChordTable::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_chord_table_remove" dzl_shortcut_chord_table_remove :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    Ptr Dazzle.ShortcutChord.ShortcutChord -> -- chord : TInterface (Name {namespace = "Dazzle", name = "ShortcutChord"})
    IO CInt

-- | /No description available in the introspection data./
shortcutChordTableRemove ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> Dazzle.ShortcutChord.ShortcutChord
    -> m Bool
shortcutChordTableRemove :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> ShortcutChord -> m Bool
shortcutChordTableRemove ShortcutChordTable
self ShortcutChord
chord = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr ShortcutChord
chord' <- ShortcutChord -> IO (Ptr ShortcutChord)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChord
chord
    CInt
result <- Ptr ShortcutChordTable -> Ptr ShortcutChord -> IO CInt
dzl_shortcut_chord_table_remove Ptr ShortcutChordTable
self' Ptr ShortcutChord
chord'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    ShortcutChord -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChord
chord
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableRemoveMethodInfo
instance (signature ~ (Dazzle.ShortcutChord.ShortcutChord -> m Bool), MonadIO m) => O.OverloadedMethod ShortcutChordTableRemoveMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableRemove

instance O.OverloadedMethodInfo ShortcutChordTableRemoveMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableRemove",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableRemove"
        })


#endif

-- method ShortcutChordTable::remove_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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 TPtr
--           , 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 : False
-- Skip return : False

foreign import ccall "dzl_shortcut_chord_table_remove_data" dzl_shortcut_chord_table_remove_data :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO CInt

-- | /No description available in the introspection data./
shortcutChordTableRemoveData ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> Ptr ()
    -> m Bool
shortcutChordTableRemoveData :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> Ptr () -> m Bool
shortcutChordTableRemoveData ShortcutChordTable
self Ptr ()
data_ = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    CInt
result <- Ptr ShortcutChordTable -> Ptr () -> IO CInt
dzl_shortcut_chord_table_remove_data Ptr ShortcutChordTable
self' Ptr ()
data_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableRemoveDataMethodInfo
instance (signature ~ (Ptr () -> m Bool), MonadIO m) => O.OverloadedMethod ShortcutChordTableRemoveDataMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableRemoveData

instance O.OverloadedMethodInfo ShortcutChordTableRemoveDataMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableRemoveData",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableRemoveData"
        })


#endif

-- method ShortcutChordTable::set_free_func
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_shortcut_chord_table_set_free_func" dzl_shortcut_chord_table_set_free_func :: 
    Ptr ShortcutChordTable ->               -- self : TInterface (Name {namespace = "Dazzle", name = "ShortcutChordTable"})
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | /No description available in the introspection data./
shortcutChordTableSetFreeFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> GLib.Callbacks.DestroyNotify
    -> m ()
shortcutChordTableSetFreeFunc :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> IO () -> m ()
shortcutChordTableSetFreeFunc ShortcutChordTable
self IO ()
notify = 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 ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Ptr (FunPtr (Ptr () -> IO ()))
ptrnotify <- IO (Ptr (FunPtr (Ptr () -> IO ())))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
    FunPtr (Ptr () -> IO ())
notify' <- (Ptr () -> IO ()) -> IO (FunPtr (Ptr () -> IO ()))
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr (Ptr () -> IO ())))
-> (Ptr () -> IO ()) -> Ptr () -> IO ()
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr (Ptr () -> IO ()))
-> Maybe (Ptr (FunPtr (Ptr () -> IO ())))
forall a. a -> Maybe a
Just Ptr (FunPtr (Ptr () -> IO ()))
ptrnotify) (IO () -> Ptr () -> IO ()
GLib.Callbacks.drop_closures_DestroyNotify IO ()
notify))
    Ptr (FunPtr (Ptr () -> IO ())) -> FunPtr (Ptr () -> IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr (Ptr () -> IO ()))
ptrnotify FunPtr (Ptr () -> IO ())
notify'
    Ptr ShortcutChordTable -> FunPtr (Ptr () -> IO ()) -> IO ()
dzl_shortcut_chord_table_set_free_func Ptr ShortcutChordTable
self' FunPtr (Ptr () -> IO ())
notify'
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableSetFreeFuncMethodInfo
instance (signature ~ (GLib.Callbacks.DestroyNotify -> m ()), MonadIO m) => O.OverloadedMethod ShortcutChordTableSetFreeFuncMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableSetFreeFunc

instance O.OverloadedMethodInfo ShortcutChordTableSetFreeFuncMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableSetFreeFunc",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableSetFreeFunc"
        })


#endif

-- method ShortcutChordTable::size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "Dazzle" , name = "ShortcutChordTable" }
--           , 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 TUInt)
-- throws : False
-- Skip return : False

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

-- | /No description available in the introspection data./
shortcutChordTableSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ShortcutChordTable
    -> m Word32
shortcutChordTableSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ShortcutChordTable -> m Word32
shortcutChordTableSize ShortcutChordTable
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ShortcutChordTable
self' <- ShortcutChordTable -> IO (Ptr ShortcutChordTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ShortcutChordTable
self
    Word32
result <- Ptr ShortcutChordTable -> IO Word32
dzl_shortcut_chord_table_size Ptr ShortcutChordTable
self'
    ShortcutChordTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ShortcutChordTable
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ShortcutChordTableSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ShortcutChordTableSizeMethodInfo ShortcutChordTable signature where
    overloadedMethod = shortcutChordTableSize

instance O.OverloadedMethodInfo ShortcutChordTableSizeMethodInfo ShortcutChordTable where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutChordTable.shortcutChordTableSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutChordTable.html#v:shortcutChordTableSize"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutChordTableMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutChordTableMethod "add" o = ShortcutChordTableAddMethodInfo
    ResolveShortcutChordTableMethod "foreach" o = ShortcutChordTableForeachMethodInfo
    ResolveShortcutChordTableMethod "free" o = ShortcutChordTableFreeMethodInfo
    ResolveShortcutChordTableMethod "lookup" o = ShortcutChordTableLookupMethodInfo
    ResolveShortcutChordTableMethod "lookupData" o = ShortcutChordTableLookupDataMethodInfo
    ResolveShortcutChordTableMethod "printf" o = ShortcutChordTablePrintfMethodInfo
    ResolveShortcutChordTableMethod "remove" o = ShortcutChordTableRemoveMethodInfo
    ResolveShortcutChordTableMethod "removeData" o = ShortcutChordTableRemoveDataMethodInfo
    ResolveShortcutChordTableMethod "size" o = ShortcutChordTableSizeMethodInfo
    ResolveShortcutChordTableMethod "setFreeFunc" o = ShortcutChordTableSetFreeFuncMethodInfo
    ResolveShortcutChordTableMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif