{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A chunk of text within the source snippet.
-- 
-- The @GtkSourceSnippetChunk@ represents a single chunk of text that
-- may or may not be an edit point within the snippet. Chunks that are
-- an edit point (also called a tab stop) have the
-- [property/@snippetChunk@/:focus-position] property set.

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

module GI.GtkSource.Objects.SnippetChunk
    ( 

-- * Exported types
    SnippetChunk(..)                        ,
    IsSnippetChunk                          ,
    toSnippetChunk                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [copy]("GI.GtkSource.Objects.SnippetChunk#g:method:copy"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getContext]("GI.GtkSource.Objects.SnippetChunk#g:method:getContext"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFocusPosition]("GI.GtkSource.Objects.SnippetChunk#g:method:getFocusPosition"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSpec]("GI.GtkSource.Objects.SnippetChunk#g:method:getSpec"), [getText]("GI.GtkSource.Objects.SnippetChunk#g:method:getText"), [getTextSet]("GI.GtkSource.Objects.SnippetChunk#g:method:getTextSet"), [getTooltipText]("GI.GtkSource.Objects.SnippetChunk#g:method:getTooltipText").
-- 
-- ==== Setters
-- [setContext]("GI.GtkSource.Objects.SnippetChunk#g:method:setContext"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFocusPosition]("GI.GtkSource.Objects.SnippetChunk#g:method:setFocusPosition"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSpec]("GI.GtkSource.Objects.SnippetChunk#g:method:setSpec"), [setText]("GI.GtkSource.Objects.SnippetChunk#g:method:setText"), [setTextSet]("GI.GtkSource.Objects.SnippetChunk#g:method:setTextSet"), [setTooltipText]("GI.GtkSource.Objects.SnippetChunk#g:method:setTooltipText").

#if defined(ENABLE_OVERLOADING)
    ResolveSnippetChunkMethod               ,
#endif

-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkCopyMethodInfo              ,
#endif
    snippetChunkCopy                        ,


-- ** getContext #method:getContext#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkGetContextMethodInfo        ,
#endif
    snippetChunkGetContext                  ,


-- ** getFocusPosition #method:getFocusPosition#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkGetFocusPositionMethodInfo  ,
#endif
    snippetChunkGetFocusPosition            ,


-- ** getSpec #method:getSpec#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkGetSpecMethodInfo           ,
#endif
    snippetChunkGetSpec                     ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkGetTextMethodInfo           ,
#endif
    snippetChunkGetText                     ,


-- ** getTextSet #method:getTextSet#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkGetTextSetMethodInfo        ,
#endif
    snippetChunkGetTextSet                  ,


-- ** getTooltipText #method:getTooltipText#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkGetTooltipTextMethodInfo    ,
#endif
    snippetChunkGetTooltipText              ,


-- ** new #method:new#

    snippetChunkNew                         ,


-- ** setContext #method:setContext#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSetContextMethodInfo        ,
#endif
    snippetChunkSetContext                  ,


-- ** setFocusPosition #method:setFocusPosition#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSetFocusPositionMethodInfo  ,
#endif
    snippetChunkSetFocusPosition            ,


-- ** setSpec #method:setSpec#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSetSpecMethodInfo           ,
#endif
    snippetChunkSetSpec                     ,


-- ** setText #method:setText#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSetTextMethodInfo           ,
#endif
    snippetChunkSetText                     ,


-- ** setTextSet #method:setTextSet#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSetTextSetMethodInfo        ,
#endif
    snippetChunkSetTextSet                  ,


-- ** setTooltipText #method:setTooltipText#

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSetTooltipTextMethodInfo    ,
#endif
    snippetChunkSetTooltipText              ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    SnippetChunkContextPropertyInfo         ,
#endif
    constructSnippetChunkContext            ,
    getSnippetChunkContext                  ,
    setSnippetChunkContext                  ,
#if defined(ENABLE_OVERLOADING)
    snippetChunkContext                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetChunkFocusPositionPropertyInfo   ,
#endif
    constructSnippetChunkFocusPosition      ,
    getSnippetChunkFocusPosition            ,
    setSnippetChunkFocusPosition            ,
#if defined(ENABLE_OVERLOADING)
    snippetChunkFocusPosition               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetChunkSpecPropertyInfo            ,
#endif
    constructSnippetChunkSpec               ,
    getSnippetChunkSpec                     ,
    setSnippetChunkSpec                     ,
#if defined(ENABLE_OVERLOADING)
    snippetChunkSpec                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetChunkTextPropertyInfo            ,
#endif
    constructSnippetChunkText               ,
    getSnippetChunkText                     ,
    setSnippetChunkText                     ,
#if defined(ENABLE_OVERLOADING)
    snippetChunkText                        ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetChunkTextSetPropertyInfo         ,
#endif
    constructSnippetChunkTextSet            ,
    getSnippetChunkTextSet                  ,
    setSnippetChunkTextSet                  ,
#if defined(ENABLE_OVERLOADING)
    snippetChunkTextSet                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetChunkTooltipTextPropertyInfo     ,
#endif
    constructSnippetChunkTooltipText        ,
    getSnippetChunkTooltipText              ,
    setSnippetChunkTooltipText              ,
#if defined(ENABLE_OVERLOADING)
    snippetChunkTooltipText                 ,
#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 qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetContext as GtkSource.SnippetContext

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetContext as GtkSource.SnippetContext

#endif

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

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

foreign import ccall "gtk_source_snippet_chunk_get_type"
    c_gtk_source_snippet_chunk_get_type :: IO B.Types.GType

instance B.Types.TypedObject SnippetChunk where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_snippet_chunk_get_type

instance B.Types.GObject SnippetChunk

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

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

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

-- | Convert 'SnippetChunk' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe SnippetChunk) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_snippet_chunk_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SnippetChunk -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SnippetChunk
P.Nothing = Ptr GValue -> Ptr SnippetChunk -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr SnippetChunk
forall a. Ptr a
FP.nullPtr :: FP.Ptr SnippetChunk)
    gvalueSet_ Ptr GValue
gv (P.Just SnippetChunk
obj) = SnippetChunk -> (Ptr SnippetChunk -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SnippetChunk
obj (Ptr GValue -> Ptr SnippetChunk -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SnippetChunk)
gvalueGet_ Ptr GValue
gv = do
        Ptr SnippetChunk
ptr <- Ptr GValue -> IO (Ptr SnippetChunk)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr SnippetChunk)
        if Ptr SnippetChunk
ptr Ptr SnippetChunk -> Ptr SnippetChunk -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr SnippetChunk
forall a. Ptr a
FP.nullPtr
        then SnippetChunk -> Maybe SnippetChunk
forall a. a -> Maybe a
P.Just (SnippetChunk -> Maybe SnippetChunk)
-> IO SnippetChunk -> IO (Maybe SnippetChunk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr SnippetChunk -> SnippetChunk)
-> Ptr SnippetChunk -> IO SnippetChunk
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr SnippetChunk -> SnippetChunk
SnippetChunk Ptr SnippetChunk
ptr
        else Maybe SnippetChunk -> IO (Maybe SnippetChunk)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SnippetChunk
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveSnippetChunkMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSnippetChunkMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSnippetChunkMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSnippetChunkMethod "copy" o = SnippetChunkCopyMethodInfo
    ResolveSnippetChunkMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSnippetChunkMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSnippetChunkMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSnippetChunkMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSnippetChunkMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSnippetChunkMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSnippetChunkMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSnippetChunkMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSnippetChunkMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSnippetChunkMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSnippetChunkMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSnippetChunkMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSnippetChunkMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSnippetChunkMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSnippetChunkMethod "getContext" o = SnippetChunkGetContextMethodInfo
    ResolveSnippetChunkMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSnippetChunkMethod "getFocusPosition" o = SnippetChunkGetFocusPositionMethodInfo
    ResolveSnippetChunkMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSnippetChunkMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSnippetChunkMethod "getSpec" o = SnippetChunkGetSpecMethodInfo
    ResolveSnippetChunkMethod "getText" o = SnippetChunkGetTextMethodInfo
    ResolveSnippetChunkMethod "getTextSet" o = SnippetChunkGetTextSetMethodInfo
    ResolveSnippetChunkMethod "getTooltipText" o = SnippetChunkGetTooltipTextMethodInfo
    ResolveSnippetChunkMethod "setContext" o = SnippetChunkSetContextMethodInfo
    ResolveSnippetChunkMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSnippetChunkMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSnippetChunkMethod "setFocusPosition" o = SnippetChunkSetFocusPositionMethodInfo
    ResolveSnippetChunkMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSnippetChunkMethod "setSpec" o = SnippetChunkSetSpecMethodInfo
    ResolveSnippetChunkMethod "setText" o = SnippetChunkSetTextMethodInfo
    ResolveSnippetChunkMethod "setTextSet" o = SnippetChunkSetTextSetMethodInfo
    ResolveSnippetChunkMethod "setTooltipText" o = SnippetChunkSetTooltipTextMethodInfo
    ResolveSnippetChunkMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "context"
   -- Type: TInterface (Name {namespace = "GtkSource", name = "SnippetContext"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@context@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snippetChunk #context
-- @
getSnippetChunkContext :: (MonadIO m, IsSnippetChunk o) => o -> m GtkSource.SnippetContext.SnippetContext
getSnippetChunkContext :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetChunk o) =>
o -> m SnippetContext
getSnippetChunkContext o
obj = IO SnippetContext -> m SnippetContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO SnippetContext -> m SnippetContext)
-> IO SnippetContext -> m SnippetContext
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe SnippetContext) -> IO SnippetContext
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSnippetChunkContext" (IO (Maybe SnippetContext) -> IO SnippetContext)
-> IO (Maybe SnippetContext) -> IO SnippetContext
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr SnippetContext -> SnippetContext)
-> IO (Maybe SnippetContext)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"context" ManagedPtr SnippetContext -> SnippetContext
GtkSource.SnippetContext.SnippetContext

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

-- | Construct a `GValueConstruct` with valid value for the “@context@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnippetChunkContext :: (IsSnippetChunk o, MIO.MonadIO m, GtkSource.SnippetContext.IsSnippetContext a) => a -> m (GValueConstruct o)
constructSnippetChunkContext :: forall o (m :: * -> *) a.
(IsSnippetChunk o, MonadIO m, IsSnippetContext a) =>
a -> m (GValueConstruct o)
constructSnippetChunkContext a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"context" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data SnippetChunkContextPropertyInfo
instance AttrInfo SnippetChunkContextPropertyInfo where
    type AttrAllowedOps SnippetChunkContextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetChunkContextPropertyInfo = IsSnippetChunk
    type AttrSetTypeConstraint SnippetChunkContextPropertyInfo = GtkSource.SnippetContext.IsSnippetContext
    type AttrTransferTypeConstraint SnippetChunkContextPropertyInfo = GtkSource.SnippetContext.IsSnippetContext
    type AttrTransferType SnippetChunkContextPropertyInfo = GtkSource.SnippetContext.SnippetContext
    type AttrGetType SnippetChunkContextPropertyInfo = GtkSource.SnippetContext.SnippetContext
    type AttrLabel SnippetChunkContextPropertyInfo = "context"
    type AttrOrigin SnippetChunkContextPropertyInfo = SnippetChunk
    attrGet = getSnippetChunkContext
    attrSet = setSnippetChunkContext
    attrTransfer _ v = do
        unsafeCastTo GtkSource.SnippetContext.SnippetContext v
    attrConstruct = constructSnippetChunkContext
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.context"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#g:attr:context"
        })
#endif

-- VVV Prop "focus-position"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@focus-position@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snippetChunk #focusPosition
-- @
getSnippetChunkFocusPosition :: (MonadIO m, IsSnippetChunk o) => o -> m Int32
getSnippetChunkFocusPosition :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetChunk o) =>
o -> m Int32
getSnippetChunkFocusPosition o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"focus-position"

-- | Set the value of the “@focus-position@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snippetChunk [ #focusPosition 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnippetChunkFocusPosition :: (MonadIO m, IsSnippetChunk o) => o -> Int32 -> m ()
setSnippetChunkFocusPosition :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetChunk o) =>
o -> Int32 -> m ()
setSnippetChunkFocusPosition o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"focus-position" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@focus-position@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnippetChunkFocusPosition :: (IsSnippetChunk o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructSnippetChunkFocusPosition :: forall o (m :: * -> *).
(IsSnippetChunk o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructSnippetChunkFocusPosition Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"focus-position" Int32
val

#if defined(ENABLE_OVERLOADING)
data SnippetChunkFocusPositionPropertyInfo
instance AttrInfo SnippetChunkFocusPositionPropertyInfo where
    type AttrAllowedOps SnippetChunkFocusPositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetChunkFocusPositionPropertyInfo = IsSnippetChunk
    type AttrSetTypeConstraint SnippetChunkFocusPositionPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint SnippetChunkFocusPositionPropertyInfo = (~) Int32
    type AttrTransferType SnippetChunkFocusPositionPropertyInfo = Int32
    type AttrGetType SnippetChunkFocusPositionPropertyInfo = Int32
    type AttrLabel SnippetChunkFocusPositionPropertyInfo = "focus-position"
    type AttrOrigin SnippetChunkFocusPositionPropertyInfo = SnippetChunk
    attrGet = getSnippetChunkFocusPosition
    attrSet = setSnippetChunkFocusPosition
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetChunkFocusPosition
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.focusPosition"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#g:attr:focusPosition"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@spec@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnippetChunkSpec :: (IsSnippetChunk o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSnippetChunkSpec :: forall o (m :: * -> *).
(IsSnippetChunk o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSnippetChunkSpec Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"spec" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SnippetChunkSpecPropertyInfo
instance AttrInfo SnippetChunkSpecPropertyInfo where
    type AttrAllowedOps SnippetChunkSpecPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetChunkSpecPropertyInfo = IsSnippetChunk
    type AttrSetTypeConstraint SnippetChunkSpecPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SnippetChunkSpecPropertyInfo = (~) T.Text
    type AttrTransferType SnippetChunkSpecPropertyInfo = T.Text
    type AttrGetType SnippetChunkSpecPropertyInfo = (Maybe T.Text)
    type AttrLabel SnippetChunkSpecPropertyInfo = "spec"
    type AttrOrigin SnippetChunkSpecPropertyInfo = SnippetChunk
    attrGet = getSnippetChunkSpec
    attrSet = setSnippetChunkSpec
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetChunkSpec
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.spec"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#g:attr:spec"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnippetChunkText :: (IsSnippetChunk o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSnippetChunkText :: forall o (m :: * -> *).
(IsSnippetChunk o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSnippetChunkText Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SnippetChunkTextPropertyInfo
instance AttrInfo SnippetChunkTextPropertyInfo where
    type AttrAllowedOps SnippetChunkTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetChunkTextPropertyInfo = IsSnippetChunk
    type AttrSetTypeConstraint SnippetChunkTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SnippetChunkTextPropertyInfo = (~) T.Text
    type AttrTransferType SnippetChunkTextPropertyInfo = T.Text
    type AttrGetType SnippetChunkTextPropertyInfo = T.Text
    type AttrLabel SnippetChunkTextPropertyInfo = "text"
    type AttrOrigin SnippetChunkTextPropertyInfo = SnippetChunk
    attrGet = getSnippetChunkText
    attrSet = setSnippetChunkText
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetChunkText
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#g:attr:text"
        })
#endif

-- VVV Prop "text-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@text-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snippetChunk #textSet
-- @
getSnippetChunkTextSet :: (MonadIO m, IsSnippetChunk o) => o -> m Bool
getSnippetChunkTextSet :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetChunk o) =>
o -> m Bool
getSnippetChunkTextSet o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"text-set"

-- | Set the value of the “@text-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snippetChunk [ #textSet 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnippetChunkTextSet :: (MonadIO m, IsSnippetChunk o) => o -> Bool -> m ()
setSnippetChunkTextSet :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetChunk o) =>
o -> Bool -> m ()
setSnippetChunkTextSet o
obj Bool
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"text-set" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@text-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnippetChunkTextSet :: (IsSnippetChunk o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructSnippetChunkTextSet :: forall o (m :: * -> *).
(IsSnippetChunk o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructSnippetChunkTextSet Bool
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"text-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data SnippetChunkTextSetPropertyInfo
instance AttrInfo SnippetChunkTextSetPropertyInfo where
    type AttrAllowedOps SnippetChunkTextSetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetChunkTextSetPropertyInfo = IsSnippetChunk
    type AttrSetTypeConstraint SnippetChunkTextSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint SnippetChunkTextSetPropertyInfo = (~) Bool
    type AttrTransferType SnippetChunkTextSetPropertyInfo = Bool
    type AttrGetType SnippetChunkTextSetPropertyInfo = Bool
    type AttrLabel SnippetChunkTextSetPropertyInfo = "text-set"
    type AttrOrigin SnippetChunkTextSetPropertyInfo = SnippetChunk
    attrGet = getSnippetChunkTextSet
    attrSet = setSnippetChunkTextSet
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetChunkTextSet
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.textSet"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#g:attr:textSet"
        })
#endif

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

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

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

-- | Construct a `GValueConstruct` with valid value for the “@tooltip-text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSnippetChunkTooltipText :: (IsSnippetChunk o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructSnippetChunkTooltipText :: forall o (m :: * -> *).
(IsSnippetChunk o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructSnippetChunkTooltipText Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"tooltip-text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

#if defined(ENABLE_OVERLOADING)
data SnippetChunkTooltipTextPropertyInfo
instance AttrInfo SnippetChunkTooltipTextPropertyInfo where
    type AttrAllowedOps SnippetChunkTooltipTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetChunkTooltipTextPropertyInfo = IsSnippetChunk
    type AttrSetTypeConstraint SnippetChunkTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SnippetChunkTooltipTextPropertyInfo = (~) T.Text
    type AttrTransferType SnippetChunkTooltipTextPropertyInfo = T.Text
    type AttrGetType SnippetChunkTooltipTextPropertyInfo = T.Text
    type AttrLabel SnippetChunkTooltipTextPropertyInfo = "tooltip-text"
    type AttrOrigin SnippetChunkTooltipTextPropertyInfo = SnippetChunk
    attrGet = getSnippetChunkTooltipText
    attrSet = setSnippetChunkTooltipText
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetChunkTooltipText
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.tooltipText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#g:attr:tooltipText"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SnippetChunk
type instance O.AttributeList SnippetChunk = SnippetChunkAttributeList
type SnippetChunkAttributeList = ('[ '("context", SnippetChunkContextPropertyInfo), '("focusPosition", SnippetChunkFocusPositionPropertyInfo), '("spec", SnippetChunkSpecPropertyInfo), '("text", SnippetChunkTextPropertyInfo), '("textSet", SnippetChunkTextSetPropertyInfo), '("tooltipText", SnippetChunkTooltipTextPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
snippetChunkContext :: AttrLabelProxy "context"
snippetChunkContext = AttrLabelProxy

snippetChunkFocusPosition :: AttrLabelProxy "focusPosition"
snippetChunkFocusPosition = AttrLabelProxy

snippetChunkSpec :: AttrLabelProxy "spec"
snippetChunkSpec = AttrLabelProxy

snippetChunkText :: AttrLabelProxy "text"
snippetChunkText = AttrLabelProxy

snippetChunkTextSet :: AttrLabelProxy "textSet"
snippetChunkTextSet = AttrLabelProxy

snippetChunkTooltipText :: AttrLabelProxy "tooltipText"
snippetChunkTooltipText = AttrLabelProxy

#endif

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

#endif

-- method SnippetChunk::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "GtkSource" , name = "SnippetChunk" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_chunk_new" gtk_source_snippet_chunk_new :: 
    IO (Ptr SnippetChunk)

-- | Create a new @GtkSourceSnippetChunk@ that can be added to
-- a [class/@snippet@/].
snippetChunkNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SnippetChunk
snippetChunkNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SnippetChunk
snippetChunkNew  = IO SnippetChunk -> m SnippetChunk
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SnippetChunk -> m SnippetChunk)
-> IO SnippetChunk -> m SnippetChunk
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
result <- IO (Ptr SnippetChunk)
gtk_source_snippet_chunk_new
    Text -> Ptr SnippetChunk -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetChunkNew" Ptr SnippetChunk
result
    SnippetChunk
result' <- ((ManagedPtr SnippetChunk -> SnippetChunk)
-> Ptr SnippetChunk -> IO SnippetChunk
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SnippetChunk -> SnippetChunk
SnippetChunk) Ptr SnippetChunk
result
    SnippetChunk -> IO SnippetChunk
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetChunk
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_source_snippet_chunk_copy" gtk_source_snippet_chunk_copy :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO (Ptr SnippetChunk)

-- | Copies the source snippet.
snippetChunkCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m SnippetChunk
    -- ^ __Returns:__ A t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
snippetChunkCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m SnippetChunk
snippetChunkCopy a
chunk = IO SnippetChunk -> m SnippetChunk
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SnippetChunk -> m SnippetChunk)
-> IO SnippetChunk -> m SnippetChunk
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    Ptr SnippetChunk
result <- Ptr SnippetChunk -> IO (Ptr SnippetChunk)
gtk_source_snippet_chunk_copy Ptr SnippetChunk
chunk'
    Text -> Ptr SnippetChunk -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetChunkCopy" Ptr SnippetChunk
result
    SnippetChunk
result' <- ((ManagedPtr SnippetChunk -> SnippetChunk)
-> Ptr SnippetChunk -> IO SnippetChunk
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr SnippetChunk -> SnippetChunk
SnippetChunk) Ptr SnippetChunk
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    SnippetChunk -> IO SnippetChunk
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetChunk
result'

#if defined(ENABLE_OVERLOADING)
data SnippetChunkCopyMethodInfo
instance (signature ~ (m SnippetChunk), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkCopyMethodInfo a signature where
    overloadedMethod = snippetChunkCopy

instance O.OverloadedMethodInfo SnippetChunkCopyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkCopy"
        })


#endif

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

foreign import ccall "gtk_source_snippet_chunk_get_context" gtk_source_snippet_chunk_get_context :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO (Ptr GtkSource.SnippetContext.SnippetContext)

-- | Gets the context for the snippet insertion.
snippetChunkGetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m GtkSource.SnippetContext.SnippetContext
    -- ^ __Returns:__ A t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
snippetChunkGetContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m SnippetContext
snippetChunkGetContext a
chunk = IO SnippetContext -> m SnippetContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SnippetContext -> m SnippetContext)
-> IO SnippetContext -> m SnippetContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    Ptr SnippetContext
result <- Ptr SnippetChunk -> IO (Ptr SnippetContext)
gtk_source_snippet_chunk_get_context Ptr SnippetChunk
chunk'
    Text -> Ptr SnippetContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetChunkGetContext" Ptr SnippetContext
result
    SnippetContext
result' <- ((ManagedPtr SnippetContext -> SnippetContext)
-> Ptr SnippetContext -> IO SnippetContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SnippetContext -> SnippetContext
GtkSource.SnippetContext.SnippetContext) Ptr SnippetContext
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    SnippetContext -> IO SnippetContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetContext
result'

#if defined(ENABLE_OVERLOADING)
data SnippetChunkGetContextMethodInfo
instance (signature ~ (m GtkSource.SnippetContext.SnippetContext), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkGetContextMethodInfo a signature where
    overloadedMethod = snippetChunkGetContext

instance O.OverloadedMethodInfo SnippetChunkGetContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkGetContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkGetContext"
        })


#endif

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

foreign import ccall "gtk_source_snippet_chunk_get_focus_position" gtk_source_snippet_chunk_get_focus_position :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO Int32

-- | Gets the [property/@snippetChunk@/:focus-position].
-- 
-- The focus-position is used to determine how many tabs it takes for the
-- snippet to advanced to this chunk.
-- 
-- A focus-position of zero will be the last focus position of the snippet
-- and snippet editing ends when it has been reached.
-- 
-- A focus-position of -1 means the chunk cannot be focused by the user.
snippetChunkGetFocusPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m Int32
    -- ^ __Returns:__ the focus-position
snippetChunkGetFocusPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m Int32
snippetChunkGetFocusPosition a
chunk = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    Int32
result <- Ptr SnippetChunk -> IO Int32
gtk_source_snippet_chunk_get_focus_position Ptr SnippetChunk
chunk'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SnippetChunkGetFocusPositionMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkGetFocusPositionMethodInfo a signature where
    overloadedMethod = snippetChunkGetFocusPosition

instance O.OverloadedMethodInfo SnippetChunkGetFocusPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkGetFocusPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkGetFocusPosition"
        })


#endif

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

foreign import ccall "gtk_source_snippet_chunk_get_spec" gtk_source_snippet_chunk_get_spec :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO CString

-- | Gets the specification for the chunk.
-- 
-- The specification is evaluated for variables when other chunks are edited
-- within the snippet context. If the user has changed the text, the
-- [property/@snippetChunk@/:text] and [property/@snippetChunk@/:text-set] properties
-- are updated.
snippetChunkGetSpec ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the specification, if any
snippetChunkGetSpec :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m (Maybe Text)
snippetChunkGetSpec a
chunk = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CString
result <- Ptr SnippetChunk -> IO CString
gtk_source_snippet_chunk_get_spec Ptr SnippetChunk
chunk'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

instance O.OverloadedMethodInfo SnippetChunkGetSpecMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkGetSpec",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkGetSpec"
        })


#endif

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

foreign import ccall "gtk_source_snippet_chunk_get_text" gtk_source_snippet_chunk_get_text :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO CString

-- | Gets the [property/@snippetChunk@/:text] property.
-- 
-- The text property is updated when the user edits the text of the chunk.
-- If it has not been edited, the [property/@snippetChunk@/:spec] property is
-- returned.
snippetChunkGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m T.Text
    -- ^ __Returns:__ the text of the chunk
snippetChunkGetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m Text
snippetChunkGetText a
chunk = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CString
result <- Ptr SnippetChunk -> IO CString
gtk_source_snippet_chunk_get_text Ptr SnippetChunk
chunk'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetChunkGetText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SnippetChunkGetTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkGetTextMethodInfo a signature where
    overloadedMethod = snippetChunkGetText

instance O.OverloadedMethodInfo SnippetChunkGetTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkGetText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkGetText"
        })


#endif

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

foreign import ccall "gtk_source_snippet_chunk_get_text_set" gtk_source_snippet_chunk_get_text_set :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO CInt

-- | Gets the [property/@snippetChunk@/:text-set] property.
-- 
-- This is typically set when the user has edited a snippet chunk.
snippetChunkGetTextSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m Bool
snippetChunkGetTextSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m Bool
snippetChunkGetTextSet a
chunk = 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 SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CInt
result <- Ptr SnippetChunk -> IO CInt
gtk_source_snippet_chunk_get_text_set Ptr SnippetChunk
chunk'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SnippetChunkGetTextSetMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkGetTextSetMethodInfo a signature where
    overloadedMethod = snippetChunkGetTextSet

instance O.OverloadedMethodInfo SnippetChunkGetTextSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkGetTextSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkGetTextSet"
        })


#endif

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

foreign import ccall "gtk_source_snippet_chunk_get_tooltip_text" gtk_source_snippet_chunk_get_tooltip_text :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    IO CString

-- | /No description available in the introspection data./
snippetChunkGetTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -> m T.Text
snippetChunkGetTooltipText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> m Text
snippetChunkGetTooltipText a
chunk = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CString
result <- Ptr SnippetChunk -> IO CString
gtk_source_snippet_chunk_get_tooltip_text Ptr SnippetChunk
chunk'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetChunkGetTooltipText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SnippetChunkGetTooltipTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkGetTooltipTextMethodInfo a signature where
    overloadedMethod = snippetChunkGetTooltipText

instance O.OverloadedMethodInfo SnippetChunkGetTooltipTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkGetTooltipText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkGetTooltipText"
        })


#endif

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

-- | /No description available in the introspection data./
snippetChunkSetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a, GtkSource.SnippetContext.IsSnippetContext b) =>
    a
    -> b
    -> m ()
snippetChunkSetContext :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnippetChunk a, IsSnippetContext b) =>
a -> b -> m ()
snippetChunkSetContext a
chunk b
context = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    Ptr SnippetContext
context' <- b -> IO (Ptr SnippetContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr SnippetChunk -> Ptr SnippetContext -> IO ()
gtk_source_snippet_chunk_set_context Ptr SnippetChunk
chunk' Ptr SnippetContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetChunkSetContextMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSnippetChunk a, GtkSource.SnippetContext.IsSnippetContext b) => O.OverloadedMethod SnippetChunkSetContextMethodInfo a signature where
    overloadedMethod = snippetChunkSetContext

instance O.OverloadedMethodInfo SnippetChunkSetContextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkSetContext",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkSetContext"
        })


#endif

-- method SnippetChunk::set_focus_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SnippetChunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetChunk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "focus_position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the focus-position" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_chunk_set_focus_position" gtk_source_snippet_chunk_set_focus_position :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    Int32 ->                                -- focus_position : TBasicType TInt
    IO ()

-- | Sets the [property/@snippetChunk@/:focus-position] property.
-- 
-- The focus-position is used to determine how many tabs it takes for the
-- snippet to advanced to this chunk.
-- 
-- A focus-position of zero will be the last focus position of the snippet
-- and snippet editing ends when it has been reached.
-- 
-- A focus-position of -1 means the chunk cannot be focused by the user.
snippetChunkSetFocusPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> Int32
    -- ^ /@focusPosition@/: the focus-position
    -> m ()
snippetChunkSetFocusPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> Int32 -> m ()
snippetChunkSetFocusPosition a
chunk Int32
focusPosition = 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 SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    Ptr SnippetChunk -> Int32 -> IO ()
gtk_source_snippet_chunk_set_focus_position Ptr SnippetChunk
chunk' Int32
focusPosition
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetChunkSetFocusPositionMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkSetFocusPositionMethodInfo a signature where
    overloadedMethod = snippetChunkSetFocusPosition

instance O.OverloadedMethodInfo SnippetChunkSetFocusPositionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkSetFocusPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkSetFocusPosition"
        })


#endif

-- method SnippetChunk::set_spec
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SnippetChunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetChunk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "spec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new specification for the chunk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_chunk_set_spec" gtk_source_snippet_chunk_set_spec :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    CString ->                              -- spec : TBasicType TUTF8
    IO ()

-- | Sets the specification for the chunk.
-- 
-- The specification is evaluated for variables when other chunks are edited
-- within the snippet context. If the user has changed the text, the
-- [property/@snippetChunk@/:text and] [property/@snippetChunk@/:text-set] properties
-- are updated.
snippetChunkSetSpec ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> T.Text
    -- ^ /@spec@/: the new specification for the chunk
    -> m ()
snippetChunkSetSpec :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> Text -> m ()
snippetChunkSetSpec a
chunk Text
spec = 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 SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CString
spec' <- Text -> IO CString
textToCString Text
spec
    Ptr SnippetChunk -> CString -> IO ()
gtk_source_snippet_chunk_set_spec Ptr SnippetChunk
chunk' CString
spec'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
spec'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SnippetChunkSetSpecMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkSetSpec",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkSetSpec"
        })


#endif

-- method SnippetChunk::set_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SnippetChunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetChunk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the text of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_chunk_set_text" gtk_source_snippet_chunk_set_text :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Sets the text for the snippet chunk.
-- 
-- This is usually used by the snippet engine to update the text, but may
-- be useful when creating custom snippets to avoid expansion of any
-- specification.
snippetChunkSetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> T.Text
    -- ^ /@text@/: the text of the property
    -> m ()
snippetChunkSetText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> Text -> m ()
snippetChunkSetText a
chunk Text
text = 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 SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr SnippetChunk -> CString -> IO ()
gtk_source_snippet_chunk_set_text Ptr SnippetChunk
chunk' CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SnippetChunkSetTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkSetText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkSetText"
        })


#endif

-- method SnippetChunk::set_text_set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SnippetChunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetChunk"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text_set"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_chunk_set_text_set" gtk_source_snippet_chunk_set_text_set :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    CInt ->                                 -- text_set : TBasicType TBoolean
    IO ()

-- | Sets the [property/@snippetChunk@/:text-set] property.
-- 
-- This is typically set when the user has edited a snippet chunk by the
-- snippet engine.
snippetChunkSetTextSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> Bool
    -- ^ /@textSet@/: the property value
    -> m ()
snippetChunkSetTextSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> Bool -> m ()
snippetChunkSetTextSet a
chunk Bool
textSet = 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 SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    let textSet' :: CInt
textSet' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
textSet
    Ptr SnippetChunk -> CInt -> IO ()
gtk_source_snippet_chunk_set_text_set Ptr SnippetChunk
chunk' CInt
textSet'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetChunkSetTextSetMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsSnippetChunk a) => O.OverloadedMethod SnippetChunkSetTextSetMethodInfo a signature where
    overloadedMethod = snippetChunkSetTextSet

instance O.OverloadedMethodInfo SnippetChunkSetTextSetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkSetTextSet",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkSetTextSet"
        })


#endif

-- method SnippetChunk::set_tooltip_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "SnippetChunk" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tooltip_text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_chunk_set_tooltip_text" gtk_source_snippet_chunk_set_tooltip_text :: 
    Ptr SnippetChunk ->                     -- chunk : TInterface (Name {namespace = "GtkSource", name = "SnippetChunk"})
    CString ->                              -- tooltip_text : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
snippetChunkSetTooltipText ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetChunk a) =>
    a
    -> T.Text
    -> m ()
snippetChunkSetTooltipText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetChunk a) =>
a -> Text -> m ()
snippetChunkSetTooltipText a
chunk Text
tooltipText = 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 SnippetChunk
chunk' <- a -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
chunk
    CString
tooltipText' <- Text -> IO CString
textToCString Text
tooltipText
    Ptr SnippetChunk -> CString -> IO ()
gtk_source_snippet_chunk_set_tooltip_text Ptr SnippetChunk
chunk' CString
tooltipText'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
chunk
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
tooltipText'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo SnippetChunkSetTooltipTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetChunk.snippetChunkSetTooltipText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-SnippetChunk.html#v:snippetChunkSetTooltipText"
        })


#endif