{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Dazzle.Structs.ShortcutEntry.ShortcutEntry' structure can be used to bulk register shortcuts
-- for a particular widget. It can also do the necessary hooks of registering
-- commands that can be changed using the keytheme components.

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

module GI.Dazzle.Structs.ShortcutEntry
    ( 

-- * Exported types
    ShortcutEntry(..)                       ,
    newZeroShortcutEntry                    ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolveShortcutEntryMethod              ,
#endif



 -- * Properties


-- ** command #attr:command#
-- | the command identifier

    clearShortcutEntryCommand               ,
    getShortcutEntryCommand                 ,
    setShortcutEntryCommand                 ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_command                   ,
#endif


-- ** defaultAccel #attr:defaultAccel#
-- | the default accelerator for the command, if any

    clearShortcutEntryDefaultAccel          ,
    getShortcutEntryDefaultAccel            ,
    setShortcutEntryDefaultAccel            ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_defaultAccel              ,
#endif


-- ** group #attr:group#
-- | the group for the shortcuts window

    clearShortcutEntryGroup                 ,
    getShortcutEntryGroup                   ,
    setShortcutEntryGroup                   ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_group                     ,
#endif


-- ** phase #attr:phase#
-- | the phase for activation, or 0 for the default

    getShortcutEntryPhase                   ,
    setShortcutEntryPhase                   ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_phase                     ,
#endif


-- ** section #attr:section#
-- | the section for the shortcuts window

    clearShortcutEntrySection               ,
    getShortcutEntrySection                 ,
    setShortcutEntrySection                 ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_section                   ,
#endif


-- ** subtitle #attr:subtitle#
-- | the subtitle for the shortcuts window, if any

    clearShortcutEntrySubtitle              ,
    getShortcutEntrySubtitle                ,
    setShortcutEntrySubtitle                ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_subtitle                  ,
#endif


-- ** title #attr:title#
-- | the title for the shortcuts window

    clearShortcutEntryTitle                 ,
    getShortcutEntryTitle                   ,
    setShortcutEntryTitle                   ,
#if defined(ENABLE_OVERLOADING)
    shortcutEntry_title                     ,
#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.Flags as Dazzle.Flags

#else
import {-# SOURCE #-} qualified GI.Dazzle.Flags as Dazzle.Flags

#endif

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

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

instance BoxedPtr ShortcutEntry where
    boxedPtrCopy :: ShortcutEntry -> IO ShortcutEntry
boxedPtrCopy = \ShortcutEntry
p -> ShortcutEntry
-> (Ptr ShortcutEntry -> IO ShortcutEntry) -> IO ShortcutEntry
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ShortcutEntry
p (Int -> Ptr ShortcutEntry -> IO (Ptr ShortcutEntry)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
56 (Ptr ShortcutEntry -> IO (Ptr ShortcutEntry))
-> (Ptr ShortcutEntry -> IO ShortcutEntry)
-> Ptr ShortcutEntry
-> IO ShortcutEntry
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr ShortcutEntry -> ShortcutEntry)
-> Ptr ShortcutEntry -> IO ShortcutEntry
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr ShortcutEntry -> ShortcutEntry
ShortcutEntry)
    boxedPtrFree :: ShortcutEntry -> IO ()
boxedPtrFree = \ShortcutEntry
x -> ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr ShortcutEntry
x Ptr ShortcutEntry -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr ShortcutEntry where
    boxedPtrCalloc :: IO (Ptr ShortcutEntry)
boxedPtrCalloc = Int -> IO (Ptr ShortcutEntry)
forall a. Int -> IO (Ptr a)
callocBytes Int
56


-- | Construct a `ShortcutEntry` struct initialized to zero.
newZeroShortcutEntry :: MonadIO m => m ShortcutEntry
newZeroShortcutEntry :: forall (m :: * -> *). MonadIO m => m ShortcutEntry
newZeroShortcutEntry = IO ShortcutEntry -> m ShortcutEntry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortcutEntry -> m ShortcutEntry)
-> IO ShortcutEntry -> m ShortcutEntry
forall a b. (a -> b) -> a -> b
$ IO (Ptr ShortcutEntry)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr ShortcutEntry)
-> (Ptr ShortcutEntry -> IO ShortcutEntry) -> IO ShortcutEntry
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr ShortcutEntry -> ShortcutEntry)
-> Ptr ShortcutEntry -> IO ShortcutEntry
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr ShortcutEntry -> ShortcutEntry
ShortcutEntry

instance tag ~ 'AttrSet => Constructible ShortcutEntry tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr ShortcutEntry -> ShortcutEntry)
-> [AttrOp ShortcutEntry tag] -> m ShortcutEntry
new ManagedPtr ShortcutEntry -> ShortcutEntry
_ [AttrOp ShortcutEntry tag]
attrs = do
        ShortcutEntry
o <- m ShortcutEntry
forall (m :: * -> *). MonadIO m => m ShortcutEntry
newZeroShortcutEntry
        ShortcutEntry -> [AttrOp ShortcutEntry 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set ShortcutEntry
o [AttrOp ShortcutEntry tag]
[AttrOp ShortcutEntry 'AttrSet]
attrs
        ShortcutEntry -> m ShortcutEntry
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ShortcutEntry
o


-- | Get the value of the “@command@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #command
-- @
getShortcutEntryCommand :: MonadIO m => ShortcutEntry -> m (Maybe T.Text)
getShortcutEntryCommand :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m (Maybe Text)
getShortcutEntryCommand ShortcutEntry
s = 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
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@command@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #command 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntryCommand :: MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryCommand :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryCommand ShortcutEntry
s CString
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@command@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #command
-- @
clearShortcutEntryCommand :: MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryCommand :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryCommand ShortcutEntry
s = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntryCommandFieldInfo
instance AttrInfo ShortcutEntryCommandFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntryCommandFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntryCommandFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ShortcutEntryCommandFieldInfo = (~) CString
    type AttrTransferTypeConstraint ShortcutEntryCommandFieldInfo = (~)CString
    type AttrTransferType ShortcutEntryCommandFieldInfo = CString
    type AttrGetType ShortcutEntryCommandFieldInfo = Maybe T.Text
    type AttrLabel ShortcutEntryCommandFieldInfo = "command"
    type AttrOrigin ShortcutEntryCommandFieldInfo = ShortcutEntry
    attrGet = getShortcutEntryCommand
    attrSet = setShortcutEntryCommand
    attrConstruct = undefined
    attrClear = clearShortcutEntryCommand
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.command"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:command"
        })

shortcutEntry_command :: AttrLabelProxy "command"
shortcutEntry_command = AttrLabelProxy

#endif


-- | Get the value of the “@phase@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #phase
-- @
getShortcutEntryPhase :: MonadIO m => ShortcutEntry -> m [Dazzle.Flags.ShortcutPhase]
getShortcutEntryPhase :: forall (m :: * -> *).
MonadIO m =>
ShortcutEntry -> m [ShortcutPhase]
getShortcutEntryPhase ShortcutEntry
s = IO [ShortcutPhase] -> m [ShortcutPhase]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ShortcutPhase] -> m [ShortcutPhase])
-> IO [ShortcutPhase] -> m [ShortcutPhase]
forall a b. (a -> b) -> a -> b
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO [ShortcutPhase]) -> IO [ShortcutPhase]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO [ShortcutPhase]) -> IO [ShortcutPhase])
-> (Ptr ShortcutEntry -> IO [ShortcutPhase]) -> IO [ShortcutPhase]
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CUInt
    let val' :: [ShortcutPhase]
val' = CUInt -> [ShortcutPhase]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [ShortcutPhase] -> IO [ShortcutPhase]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [ShortcutPhase]
val'

-- | Set the value of the “@phase@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #phase 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntryPhase :: MonadIO m => ShortcutEntry -> [Dazzle.Flags.ShortcutPhase] -> m ()
setShortcutEntryPhase :: forall (m :: * -> *).
MonadIO m =>
ShortcutEntry -> [ShortcutPhase] -> m ()
setShortcutEntryPhase ShortcutEntry
s [ShortcutPhase]
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    let val' :: CUInt
val' = [ShortcutPhase] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ShortcutPhase]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntryPhaseFieldInfo
instance AttrInfo ShortcutEntryPhaseFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntryPhaseFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntryPhaseFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint ShortcutEntryPhaseFieldInfo = (~) [Dazzle.Flags.ShortcutPhase]
    type AttrTransferTypeConstraint ShortcutEntryPhaseFieldInfo = (~)[Dazzle.Flags.ShortcutPhase]
    type AttrTransferType ShortcutEntryPhaseFieldInfo = [Dazzle.Flags.ShortcutPhase]
    type AttrGetType ShortcutEntryPhaseFieldInfo = [Dazzle.Flags.ShortcutPhase]
    type AttrLabel ShortcutEntryPhaseFieldInfo = "phase"
    type AttrOrigin ShortcutEntryPhaseFieldInfo = ShortcutEntry
    attrGet = getShortcutEntryPhase
    attrSet = setShortcutEntryPhase
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.phase"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:phase"
        })

shortcutEntry_phase :: AttrLabelProxy "phase"
shortcutEntry_phase = AttrLabelProxy

#endif


-- | Get the value of the “@default_accel@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #defaultAccel
-- @
getShortcutEntryDefaultAccel :: MonadIO m => ShortcutEntry -> m (Maybe T.Text)
getShortcutEntryDefaultAccel :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m (Maybe Text)
getShortcutEntryDefaultAccel ShortcutEntry
s = 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
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@default_accel@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #defaultAccel 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntryDefaultAccel :: MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryDefaultAccel :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryDefaultAccel ShortcutEntry
s CString
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@default_accel@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #defaultAccel
-- @
clearShortcutEntryDefaultAccel :: MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryDefaultAccel :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryDefaultAccel ShortcutEntry
s = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntryDefaultAccelFieldInfo
instance AttrInfo ShortcutEntryDefaultAccelFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntryDefaultAccelFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntryDefaultAccelFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ShortcutEntryDefaultAccelFieldInfo = (~) CString
    type AttrTransferTypeConstraint ShortcutEntryDefaultAccelFieldInfo = (~)CString
    type AttrTransferType ShortcutEntryDefaultAccelFieldInfo = CString
    type AttrGetType ShortcutEntryDefaultAccelFieldInfo = Maybe T.Text
    type AttrLabel ShortcutEntryDefaultAccelFieldInfo = "default_accel"
    type AttrOrigin ShortcutEntryDefaultAccelFieldInfo = ShortcutEntry
    attrGet = getShortcutEntryDefaultAccel
    attrSet = setShortcutEntryDefaultAccel
    attrConstruct = undefined
    attrClear = clearShortcutEntryDefaultAccel
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.defaultAccel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:defaultAccel"
        })

shortcutEntry_defaultAccel :: AttrLabelProxy "defaultAccel"
shortcutEntry_defaultAccel = AttrLabelProxy

#endif


-- | Get the value of the “@section@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #section
-- @
getShortcutEntrySection :: MonadIO m => ShortcutEntry -> m (Maybe T.Text)
getShortcutEntrySection :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m (Maybe Text)
getShortcutEntrySection ShortcutEntry
s = 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
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@section@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #section 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntrySection :: MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntrySection :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntrySection ShortcutEntry
s CString
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
val :: CString)

-- | Set the value of the “@section@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #section
-- @
clearShortcutEntrySection :: MonadIO m => ShortcutEntry -> m ()
clearShortcutEntrySection :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m ()
clearShortcutEntrySection ShortcutEntry
s = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntrySectionFieldInfo
instance AttrInfo ShortcutEntrySectionFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntrySectionFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntrySectionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ShortcutEntrySectionFieldInfo = (~) CString
    type AttrTransferTypeConstraint ShortcutEntrySectionFieldInfo = (~)CString
    type AttrTransferType ShortcutEntrySectionFieldInfo = CString
    type AttrGetType ShortcutEntrySectionFieldInfo = Maybe T.Text
    type AttrLabel ShortcutEntrySectionFieldInfo = "section"
    type AttrOrigin ShortcutEntrySectionFieldInfo = ShortcutEntry
    attrGet = getShortcutEntrySection
    attrSet = setShortcutEntrySection
    attrConstruct = undefined
    attrClear = clearShortcutEntrySection
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.section"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:section"
        })

shortcutEntry_section :: AttrLabelProxy "section"
shortcutEntry_section = AttrLabelProxy

#endif


-- | Get the value of the “@group@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #group
-- @
getShortcutEntryGroup :: MonadIO m => ShortcutEntry -> m (Maybe T.Text)
getShortcutEntryGroup :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m (Maybe Text)
getShortcutEntryGroup ShortcutEntry
s = 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
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@group@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #group 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntryGroup :: MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryGroup :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryGroup ShortcutEntry
s CString
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (CString
val :: CString)

-- | Set the value of the “@group@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #group
-- @
clearShortcutEntryGroup :: MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryGroup :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryGroup ShortcutEntry
s = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntryGroupFieldInfo
instance AttrInfo ShortcutEntryGroupFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntryGroupFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntryGroupFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ShortcutEntryGroupFieldInfo = (~) CString
    type AttrTransferTypeConstraint ShortcutEntryGroupFieldInfo = (~)CString
    type AttrTransferType ShortcutEntryGroupFieldInfo = CString
    type AttrGetType ShortcutEntryGroupFieldInfo = Maybe T.Text
    type AttrLabel ShortcutEntryGroupFieldInfo = "group"
    type AttrOrigin ShortcutEntryGroupFieldInfo = ShortcutEntry
    attrGet = getShortcutEntryGroup
    attrSet = setShortcutEntryGroup
    attrConstruct = undefined
    attrClear = clearShortcutEntryGroup
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.group"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:group"
        })

shortcutEntry_group :: AttrLabelProxy "group"
shortcutEntry_group = AttrLabelProxy

#endif


-- | Get the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #title
-- @
getShortcutEntryTitle :: MonadIO m => ShortcutEntry -> m (Maybe T.Text)
getShortcutEntryTitle :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m (Maybe Text)
getShortcutEntryTitle ShortcutEntry
s = 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
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@title@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #title 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntryTitle :: MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryTitle :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntryTitle ShortcutEntry
s CString
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CString
val :: CString)

-- | Set the value of the “@title@” field 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
-- @
clearShortcutEntryTitle :: MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryTitle :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m ()
clearShortcutEntryTitle ShortcutEntry
s = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntryTitleFieldInfo
instance AttrInfo ShortcutEntryTitleFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntryTitleFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntryTitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ShortcutEntryTitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ShortcutEntryTitleFieldInfo = (~)CString
    type AttrTransferType ShortcutEntryTitleFieldInfo = CString
    type AttrGetType ShortcutEntryTitleFieldInfo = Maybe T.Text
    type AttrLabel ShortcutEntryTitleFieldInfo = "title"
    type AttrOrigin ShortcutEntryTitleFieldInfo = ShortcutEntry
    attrGet = getShortcutEntryTitle
    attrSet = setShortcutEntryTitle
    attrConstruct = undefined
    attrClear = clearShortcutEntryTitle
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:title"
        })

shortcutEntry_title :: AttrLabelProxy "title"
shortcutEntry_title = AttrLabelProxy

#endif


-- | Get the value of the “@subtitle@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' shortcutEntry #subtitle
-- @
getShortcutEntrySubtitle :: MonadIO m => ShortcutEntry -> m (Maybe T.Text)
getShortcutEntrySubtitle :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m (Maybe Text)
getShortcutEntrySubtitle ShortcutEntry
s = 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
$ ShortcutEntry
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr ShortcutEntry -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@subtitle@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' shortcutEntry [ #subtitle 'Data.GI.Base.Attributes.:=' value ]
-- @
setShortcutEntrySubtitle :: MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntrySubtitle :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> CString -> m ()
setShortcutEntrySubtitle ShortcutEntry
s CString
val = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
val :: CString)

-- | Set the value of the “@subtitle@” field 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
-- @
clearShortcutEntrySubtitle :: MonadIO m => ShortcutEntry -> m ()
clearShortcutEntrySubtitle :: forall (m :: * -> *). MonadIO m => ShortcutEntry -> m ()
clearShortcutEntrySubtitle ShortcutEntry
s = 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
$ ShortcutEntry -> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr ShortcutEntry
s ((Ptr ShortcutEntry -> IO ()) -> IO ())
-> (Ptr ShortcutEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ShortcutEntry
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ShortcutEntry
ptr Ptr ShortcutEntry -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data ShortcutEntrySubtitleFieldInfo
instance AttrInfo ShortcutEntrySubtitleFieldInfo where
    type AttrBaseTypeConstraint ShortcutEntrySubtitleFieldInfo = (~) ShortcutEntry
    type AttrAllowedOps ShortcutEntrySubtitleFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint ShortcutEntrySubtitleFieldInfo = (~) CString
    type AttrTransferTypeConstraint ShortcutEntrySubtitleFieldInfo = (~)CString
    type AttrTransferType ShortcutEntrySubtitleFieldInfo = CString
    type AttrGetType ShortcutEntrySubtitleFieldInfo = Maybe T.Text
    type AttrLabel ShortcutEntrySubtitleFieldInfo = "subtitle"
    type AttrOrigin ShortcutEntrySubtitleFieldInfo = ShortcutEntry
    attrGet = getShortcutEntrySubtitle
    attrSet = setShortcutEntrySubtitle
    attrConstruct = undefined
    attrClear = clearShortcutEntrySubtitle
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.ShortcutEntry.subtitle"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-ShortcutEntry.html#g:attr:subtitle"
        })

shortcutEntry_subtitle :: AttrLabelProxy "subtitle"
shortcutEntry_subtitle = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ShortcutEntry
type instance O.AttributeList ShortcutEntry = ShortcutEntryAttributeList
type ShortcutEntryAttributeList = ('[ '("command", ShortcutEntryCommandFieldInfo), '("phase", ShortcutEntryPhaseFieldInfo), '("defaultAccel", ShortcutEntryDefaultAccelFieldInfo), '("section", ShortcutEntrySectionFieldInfo), '("group", ShortcutEntryGroupFieldInfo), '("title", ShortcutEntryTitleFieldInfo), '("subtitle", ShortcutEntrySubtitleFieldInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveShortcutEntryMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveShortcutEntryMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif