{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Quick insertion code snippets.
-- 
-- The @GtkSourceSnippet@ represents a series of chunks that can quickly be
-- inserted into the [class/@view@/].
-- 
-- Snippets are defined in XML files which are loaded by the
-- [class/@snippetManager@/]. Alternatively, applications can create snippets
-- on demand and insert them into the [class/@view@/] using
-- [method/@view@/.push_snippet].
-- 
-- Snippet chunks can reference other snippet chunks as well as post-process
-- the values from other chunks such as capitalization.

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

module GI.GtkSource.Objects.Snippet
    ( 

-- * Exported types
    Snippet(..)                             ,
    IsSnippet                               ,
    toSnippet                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addChunk]("GI.GtkSource.Objects.Snippet#g:method:addChunk"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [copy]("GI.GtkSource.Objects.Snippet#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.Snippet#g:method:getContext"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDescription]("GI.GtkSource.Objects.Snippet#g:method:getDescription"), [getFocusPosition]("GI.GtkSource.Objects.Snippet#g:method:getFocusPosition"), [getLanguageId]("GI.GtkSource.Objects.Snippet#g:method:getLanguageId"), [getNChunks]("GI.GtkSource.Objects.Snippet#g:method:getNChunks"), [getName]("GI.GtkSource.Objects.Snippet#g:method:getName"), [getNthChunk]("GI.GtkSource.Objects.Snippet#g:method:getNthChunk"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTrigger]("GI.GtkSource.Objects.Snippet#g:method:getTrigger").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDescription]("GI.GtkSource.Objects.Snippet#g:method:setDescription"), [setLanguageId]("GI.GtkSource.Objects.Snippet#g:method:setLanguageId"), [setName]("GI.GtkSource.Objects.Snippet#g:method:setName"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTrigger]("GI.GtkSource.Objects.Snippet#g:method:setTrigger").

#if defined(ENABLE_OVERLOADING)
    ResolveSnippetMethod                    ,
#endif

-- ** addChunk #method:addChunk#

#if defined(ENABLE_OVERLOADING)
    SnippetAddChunkMethodInfo               ,
#endif
    snippetAddChunk                         ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    SnippetCopyMethodInfo                   ,
#endif
    snippetCopy                             ,


-- ** getContext #method:getContext#

#if defined(ENABLE_OVERLOADING)
    SnippetGetContextMethodInfo             ,
#endif
    snippetGetContext                       ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    SnippetGetDescriptionMethodInfo         ,
#endif
    snippetGetDescription                   ,


-- ** getFocusPosition #method:getFocusPosition#

#if defined(ENABLE_OVERLOADING)
    SnippetGetFocusPositionMethodInfo       ,
#endif
    snippetGetFocusPosition                 ,


-- ** getLanguageId #method:getLanguageId#

#if defined(ENABLE_OVERLOADING)
    SnippetGetLanguageIdMethodInfo          ,
#endif
    snippetGetLanguageId                    ,


-- ** getNChunks #method:getNChunks#

#if defined(ENABLE_OVERLOADING)
    SnippetGetNChunksMethodInfo             ,
#endif
    snippetGetNChunks                       ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    SnippetGetNameMethodInfo                ,
#endif
    snippetGetName                          ,


-- ** getNthChunk #method:getNthChunk#

#if defined(ENABLE_OVERLOADING)
    SnippetGetNthChunkMethodInfo            ,
#endif
    snippetGetNthChunk                      ,


-- ** getTrigger #method:getTrigger#

#if defined(ENABLE_OVERLOADING)
    SnippetGetTriggerMethodInfo             ,
#endif
    snippetGetTrigger                       ,


-- ** new #method:new#

    snippetNew                              ,


-- ** newParsed #method:newParsed#

    snippetNewParsed                        ,


-- ** setDescription #method:setDescription#

#if defined(ENABLE_OVERLOADING)
    SnippetSetDescriptionMethodInfo         ,
#endif
    snippetSetDescription                   ,


-- ** setLanguageId #method:setLanguageId#

#if defined(ENABLE_OVERLOADING)
    SnippetSetLanguageIdMethodInfo          ,
#endif
    snippetSetLanguageId                    ,


-- ** setName #method:setName#

#if defined(ENABLE_OVERLOADING)
    SnippetSetNameMethodInfo                ,
#endif
    snippetSetName                          ,


-- ** setTrigger #method:setTrigger#

#if defined(ENABLE_OVERLOADING)
    SnippetSetTriggerMethodInfo             ,
#endif
    snippetSetTrigger                       ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    SnippetBufferPropertyInfo               ,
#endif
    getSnippetBuffer                        ,
#if defined(ENABLE_OVERLOADING)
    snippetBuffer                           ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetDescriptionPropertyInfo          ,
#endif
    constructSnippetDescription             ,
    getSnippetDescription                   ,
    setSnippetDescription                   ,
#if defined(ENABLE_OVERLOADING)
    snippetDescription                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetFocusPositionPropertyInfo        ,
#endif
    getSnippetFocusPosition                 ,
#if defined(ENABLE_OVERLOADING)
    snippetFocusPosition                    ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetLanguageIdPropertyInfo           ,
#endif
    constructSnippetLanguageId              ,
    getSnippetLanguageId                    ,
    setSnippetLanguageId                    ,
#if defined(ENABLE_OVERLOADING)
    snippetLanguageId                       ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetNamePropertyInfo                 ,
#endif
    constructSnippetName                    ,
    getSnippetName                          ,
    setSnippetName                          ,
#if defined(ENABLE_OVERLOADING)
    snippetName                             ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    SnippetTriggerPropertyInfo              ,
#endif
    constructSnippetTrigger                 ,
    getSnippetTrigger                       ,
    setSnippetTrigger                       ,
#if defined(ENABLE_OVERLOADING)
    snippetTrigger                          ,
#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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetChunk as GtkSource.SnippetChunk
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetContext as GtkSource.SnippetContext

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

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

foreign import ccall "gtk_source_snippet_get_type"
    c_gtk_source_snippet_get_type :: IO B.Types.GType

instance B.Types.TypedObject Snippet where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_snippet_get_type

instance B.Types.GObject Snippet

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSnippetMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSnippetMethod "addChunk" o = SnippetAddChunkMethodInfo
    ResolveSnippetMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSnippetMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSnippetMethod "copy" o = SnippetCopyMethodInfo
    ResolveSnippetMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSnippetMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSnippetMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSnippetMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSnippetMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSnippetMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSnippetMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSnippetMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSnippetMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSnippetMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSnippetMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSnippetMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSnippetMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSnippetMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSnippetMethod "getContext" o = SnippetGetContextMethodInfo
    ResolveSnippetMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSnippetMethod "getDescription" o = SnippetGetDescriptionMethodInfo
    ResolveSnippetMethod "getFocusPosition" o = SnippetGetFocusPositionMethodInfo
    ResolveSnippetMethod "getLanguageId" o = SnippetGetLanguageIdMethodInfo
    ResolveSnippetMethod "getNChunks" o = SnippetGetNChunksMethodInfo
    ResolveSnippetMethod "getName" o = SnippetGetNameMethodInfo
    ResolveSnippetMethod "getNthChunk" o = SnippetGetNthChunkMethodInfo
    ResolveSnippetMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSnippetMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSnippetMethod "getTrigger" o = SnippetGetTriggerMethodInfo
    ResolveSnippetMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSnippetMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSnippetMethod "setDescription" o = SnippetSetDescriptionMethodInfo
    ResolveSnippetMethod "setLanguageId" o = SnippetSetLanguageIdMethodInfo
    ResolveSnippetMethod "setName" o = SnippetSetNameMethodInfo
    ResolveSnippetMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSnippetMethod "setTrigger" o = SnippetSetTriggerMethodInfo
    ResolveSnippetMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "buffer"
   -- Type: TInterface (Name {namespace = "Gtk", name = "TextBuffer"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data SnippetBufferPropertyInfo
instance AttrInfo SnippetBufferPropertyInfo where
    type AttrAllowedOps SnippetBufferPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SnippetBufferPropertyInfo = IsSnippet
    type AttrSetTypeConstraint SnippetBufferPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SnippetBufferPropertyInfo = (~) ()
    type AttrTransferType SnippetBufferPropertyInfo = ()
    type AttrGetType SnippetBufferPropertyInfo = (Maybe Gtk.TextBuffer.TextBuffer)
    type AttrLabel SnippetBufferPropertyInfo = "buffer"
    type AttrOrigin SnippetBufferPropertyInfo = Snippet
    attrGet = getSnippetBuffer
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.Snippet.buffer"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-Snippet.html#g:attr:buffer"
        })
#endif

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

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

-- | Set the value of the “@description@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snippet [ #description 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnippetDescription :: (MonadIO m, IsSnippet o) => o -> T.Text -> m ()
setSnippetDescription :: forall (m :: * -> *) o.
(MonadIO m, IsSnippet o) =>
o -> Text -> m ()
setSnippetDescription 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
"description" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

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

-- | 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' snippet #focusPosition
-- @
getSnippetFocusPosition :: (MonadIO m, IsSnippet o) => o -> m Int32
getSnippetFocusPosition :: forall (m :: * -> *) o. (MonadIO m, IsSnippet o) => o -> m Int32
getSnippetFocusPosition 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"

#if defined(ENABLE_OVERLOADING)
data SnippetFocusPositionPropertyInfo
instance AttrInfo SnippetFocusPositionPropertyInfo where
    type AttrAllowedOps SnippetFocusPositionPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint SnippetFocusPositionPropertyInfo = IsSnippet
    type AttrSetTypeConstraint SnippetFocusPositionPropertyInfo = (~) ()
    type AttrTransferTypeConstraint SnippetFocusPositionPropertyInfo = (~) ()
    type AttrTransferType SnippetFocusPositionPropertyInfo = ()
    type AttrGetType SnippetFocusPositionPropertyInfo = Int32
    type AttrLabel SnippetFocusPositionPropertyInfo = "focus-position"
    type AttrOrigin SnippetFocusPositionPropertyInfo = Snippet
    attrGet = getSnippetFocusPosition
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.Snippet.focusPosition"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-Snippet.html#g:attr:focusPosition"
        })
#endif

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

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

-- | Set the value of the “@language-id@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snippet [ #languageId 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnippetLanguageId :: (MonadIO m, IsSnippet o) => o -> T.Text -> m ()
setSnippetLanguageId :: forall (m :: * -> *) o.
(MonadIO m, IsSnippet o) =>
o -> Text -> m ()
setSnippetLanguageId 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
"language-id" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

#if defined(ENABLE_OVERLOADING)
data SnippetLanguageIdPropertyInfo
instance AttrInfo SnippetLanguageIdPropertyInfo where
    type AttrAllowedOps SnippetLanguageIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint SnippetLanguageIdPropertyInfo = IsSnippet
    type AttrSetTypeConstraint SnippetLanguageIdPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint SnippetLanguageIdPropertyInfo = (~) T.Text
    type AttrTransferType SnippetLanguageIdPropertyInfo = T.Text
    type AttrGetType SnippetLanguageIdPropertyInfo = T.Text
    type AttrLabel SnippetLanguageIdPropertyInfo = "language-id"
    type AttrOrigin SnippetLanguageIdPropertyInfo = Snippet
    attrGet = getSnippetLanguageId
    attrSet = setSnippetLanguageId
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetLanguageId
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.Snippet.languageId"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-Snippet.html#g:attr:languageId"
        })
#endif

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

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

-- | Set the value of the “@name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snippet [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnippetName :: (MonadIO m, IsSnippet o) => o -> T.Text -> m ()
setSnippetName :: forall (m :: * -> *) o.
(MonadIO m, IsSnippet o) =>
o -> Text -> m ()
setSnippetName 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
"name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

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

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

-- | Set the value of the “@trigger@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' snippet [ #trigger 'Data.GI.Base.Attributes.:=' value ]
-- @
setSnippetTrigger :: (MonadIO m, IsSnippet o) => o -> T.Text -> m ()
setSnippetTrigger :: forall (m :: * -> *) o.
(MonadIO m, IsSnippet o) =>
o -> Text -> m ()
setSnippetTrigger 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
"trigger" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Snippet
type instance O.AttributeList Snippet = SnippetAttributeList
type SnippetAttributeList = ('[ '("buffer", SnippetBufferPropertyInfo), '("description", SnippetDescriptionPropertyInfo), '("focusPosition", SnippetFocusPositionPropertyInfo), '("languageId", SnippetLanguageIdPropertyInfo), '("name", SnippetNamePropertyInfo), '("trigger", SnippetTriggerPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
snippetBuffer :: AttrLabelProxy "buffer"
snippetBuffer = AttrLabelProxy

snippetDescription :: AttrLabelProxy "description"
snippetDescription = AttrLabelProxy

snippetFocusPosition :: AttrLabelProxy "focusPosition"
snippetFocusPosition = AttrLabelProxy

snippetLanguageId :: AttrLabelProxy "languageId"
snippetLanguageId = AttrLabelProxy

snippetName :: AttrLabelProxy "name"
snippetName = AttrLabelProxy

snippetTrigger :: AttrLabelProxy "trigger"
snippetTrigger = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_source_snippet_new" gtk_source_snippet_new :: 
    CString ->                              -- trigger : TBasicType TUTF8
    CString ->                              -- language_id : TBasicType TUTF8
    IO (Ptr Snippet)

-- | Creates a new t'GI.GtkSource.Objects.Snippet.Snippet'
snippetNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@trigger@/: the trigger word
    -> Maybe (T.Text)
    -- ^ /@languageId@/: the source language
    -> m Snippet
    -- ^ __Returns:__ A new t'GI.GtkSource.Objects.Snippet.Snippet'
snippetNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> Maybe Text -> m Snippet
snippetNew Maybe Text
trigger Maybe Text
languageId = IO Snippet -> m Snippet
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Snippet -> m Snippet) -> IO Snippet -> m Snippet
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeTrigger <- case Maybe Text
trigger of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jTrigger -> do
            Ptr CChar
jTrigger' <- Text -> IO (Ptr CChar)
textToCString Text
jTrigger
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jTrigger'
    Ptr CChar
maybeLanguageId <- case Maybe Text
languageId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jLanguageId -> do
            Ptr CChar
jLanguageId' <- Text -> IO (Ptr CChar)
textToCString Text
jLanguageId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLanguageId'
    Ptr Snippet
result <- Ptr CChar -> Ptr CChar -> IO (Ptr Snippet)
gtk_source_snippet_new Ptr CChar
maybeTrigger Ptr CChar
maybeLanguageId
    Text -> Ptr Snippet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetNew" Ptr Snippet
result
    Snippet
result' <- ((ManagedPtr Snippet -> Snippet) -> Ptr Snippet -> IO Snippet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Snippet -> Snippet
Snippet) Ptr Snippet
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeTrigger
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLanguageId
    Snippet -> IO Snippet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Snippet
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Snippet::new_parsed
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the formatted snippet text to parse"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "GtkSource" , name = "Snippet" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_source_snippet_new_parsed" gtk_source_snippet_new_parsed :: 
    CString ->                              -- text : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Snippet)

-- | Parses the snippet formatted /@text@/ into a series of chunks and adds them
-- to a new t'GI.GtkSource.Objects.Snippet.Snippet'.
-- 
-- /Since: 5.6/
snippetNewParsed ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@text@/: the formatted snippet text to parse
    -> m Snippet
    -- ^ __Returns:__ the newly parsed t'GI.GtkSource.Objects.Snippet.Snippet', or 'P.Nothing' upon
    --   failure and /@error@/ is set. /(Can throw 'Data.GI.Base.GError.GError')/
snippetNewParsed :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Snippet
snippetNewParsed Text
text = IO Snippet -> m Snippet
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Snippet -> m Snippet) -> IO Snippet -> m Snippet
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
text' <- Text -> IO (Ptr CChar)
textToCString Text
text
    IO Snippet -> IO () -> IO Snippet
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Snippet
result <- (Ptr (Ptr GError) -> IO (Ptr Snippet)) -> IO (Ptr Snippet)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Snippet)) -> IO (Ptr Snippet))
-> (Ptr (Ptr GError) -> IO (Ptr Snippet)) -> IO (Ptr Snippet)
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> Ptr (Ptr GError) -> IO (Ptr Snippet)
gtk_source_snippet_new_parsed Ptr CChar
text'
        Text -> Ptr Snippet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetNewParsed" Ptr Snippet
result
        Snippet
result' <- ((ManagedPtr Snippet -> Snippet) -> Ptr Snippet -> IO Snippet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Snippet -> Snippet
Snippet) Ptr Snippet
result
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
text'
        Snippet -> IO Snippet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Snippet
result'
     ) (do
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
text'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Snippet::add_chunk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , 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: Nothing
-- throws : False
-- Skip return : False

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

-- | Appends /@chunk@/ to the /@snippet@/.
-- 
-- This may only be called before the snippet has been expanded.
snippetAddChunk ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a, GtkSource.SnippetChunk.IsSnippetChunk b) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> b
    -- ^ /@chunk@/: a t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
    -> m ()
snippetAddChunk :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSnippet a, IsSnippetChunk b) =>
a -> b -> m ()
snippetAddChunk a
snippet b
chunk = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr SnippetChunk
chunk' <- b -> IO (Ptr SnippetChunk)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
chunk
    Ptr Snippet -> Ptr SnippetChunk -> IO ()
gtk_source_snippet_add_chunk Ptr Snippet
snippet' Ptr SnippetChunk
chunk'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetAddChunkMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsSnippet a, GtkSource.SnippetChunk.IsSnippetChunk b) => O.OverloadedMethod SnippetAddChunkMethodInfo a signature where
    overloadedMethod = snippetAddChunk

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


#endif

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

foreign import ccall "gtk_source_snippet_copy" gtk_source_snippet_copy :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO (Ptr Snippet)

-- | Does a deep copy of the snippet.
snippetCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m Snippet
    -- ^ __Returns:__ A new t'GI.GtkSource.Objects.Snippet.Snippet'
snippetCopy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m Snippet
snippetCopy a
snippet = IO Snippet -> m Snippet
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Snippet -> m Snippet) -> IO Snippet -> m Snippet
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr Snippet
result <- Ptr Snippet -> IO (Ptr Snippet)
gtk_source_snippet_copy Ptr Snippet
snippet'
    Text -> Ptr Snippet -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetCopy" Ptr Snippet
result
    Snippet
result' <- ((ManagedPtr Snippet -> Snippet) -> Ptr Snippet -> IO Snippet
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Snippet -> Snippet
Snippet) Ptr Snippet
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Snippet -> IO Snippet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Snippet
result'

#if defined(ENABLE_OVERLOADING)
data SnippetCopyMethodInfo
instance (signature ~ (m Snippet), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetCopyMethodInfo a signature where
    overloadedMethod = snippetCopy

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


#endif

-- method Snippet::get_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #GtkSourceSnippet"
--                 , 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_get_context" gtk_source_snippet_get_context :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO (Ptr GtkSource.SnippetContext.SnippetContext)

-- | Gets the context used for expanding the snippet.
snippetGetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: an t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m (Maybe GtkSource.SnippetContext.SnippetContext)
    -- ^ __Returns:__ an t'GI.GtkSource.Objects.SnippetContext.SnippetContext'
snippetGetContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m (Maybe SnippetContext)
snippetGetContext a
snippet = IO (Maybe SnippetContext) -> m (Maybe SnippetContext)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SnippetContext) -> m (Maybe SnippetContext))
-> IO (Maybe SnippetContext) -> m (Maybe SnippetContext)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr SnippetContext
result <- Ptr Snippet -> IO (Ptr SnippetContext)
gtk_source_snippet_get_context Ptr Snippet
snippet'
    Maybe SnippetContext
maybeResult <- Ptr SnippetContext
-> (Ptr SnippetContext -> IO SnippetContext)
-> IO (Maybe SnippetContext)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr SnippetContext
result ((Ptr SnippetContext -> IO SnippetContext)
 -> IO (Maybe SnippetContext))
-> (Ptr SnippetContext -> IO SnippetContext)
-> IO (Maybe SnippetContext)
forall a b. (a -> b) -> a -> b
$ \Ptr SnippetContext
result' -> do
        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'
        SnippetContext -> IO SnippetContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetContext
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Maybe SnippetContext -> IO (Maybe SnippetContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SnippetContext
maybeResult

#if defined(ENABLE_OVERLOADING)
data SnippetGetContextMethodInfo
instance (signature ~ (m (Maybe GtkSource.SnippetContext.SnippetContext)), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetContextMethodInfo a signature where
    overloadedMethod = snippetGetContext

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


#endif

-- method Snippet::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , 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_get_description" gtk_source_snippet_get_description :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO CString

-- | Gets the description for the snippet.
snippetGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m T.Text
snippetGetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m Text
snippetGetDescription a
snippet = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
result <- Ptr Snippet -> IO (Ptr CChar)
gtk_source_snippet_get_description Ptr Snippet
snippet'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetGetDescription" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SnippetGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetDescriptionMethodInfo a signature where
    overloadedMethod = snippetGetDescription

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


#endif

-- method Snippet::get_focus_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , 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_get_focus_position" gtk_source_snippet_get_focus_position :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO Int32

-- | Gets the current focus for the snippet.
-- 
-- This is changed as the user tabs through focus locations.
snippetGetFocusPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m Int32
    -- ^ __Returns:__ The focus position, or -1 if unset.
snippetGetFocusPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m Int32
snippetGetFocusPosition a
snippet = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Int32
result <- Ptr Snippet -> IO Int32
gtk_source_snippet_get_focus_position Ptr Snippet
snippet'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SnippetGetFocusPositionMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetFocusPositionMethodInfo a signature where
    overloadedMethod = snippetGetFocusPosition

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


#endif

-- method Snippet::get_language_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , 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_get_language_id" gtk_source_snippet_get_language_id :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO CString

-- | Gets the language-id used for the source snippet.
-- 
-- The language identifier should be one that matches a
-- source language [property/@language@/:id] property.
snippetGetLanguageId ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m T.Text
    -- ^ __Returns:__ the language identifier
snippetGetLanguageId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m Text
snippetGetLanguageId a
snippet = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
result <- Ptr Snippet -> IO (Ptr CChar)
gtk_source_snippet_get_language_id Ptr Snippet
snippet'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetGetLanguageId" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SnippetGetLanguageIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetLanguageIdMethodInfo a signature where
    overloadedMethod = snippetGetLanguageId

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


#endif

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

foreign import ccall "gtk_source_snippet_get_n_chunks" gtk_source_snippet_get_n_chunks :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO Word32

-- | Gets the number of chunks in the snippet.
-- 
-- Note that not all chunks are editable.
snippetGetNChunks ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m Word32
    -- ^ __Returns:__ The number of chunks.
snippetGetNChunks :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m Word32
snippetGetNChunks a
snippet = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Word32
result <- Ptr Snippet -> IO Word32
gtk_source_snippet_get_n_chunks Ptr Snippet
snippet'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data SnippetGetNChunksMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetNChunksMethodInfo a signature where
    overloadedMethod = snippetGetNChunks

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


#endif

-- method Snippet::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , 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_get_name" gtk_source_snippet_get_name :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO CString

-- | Gets the name for the snippet.
snippetGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m T.Text
snippetGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m Text
snippetGetName a
snippet = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
result <- Ptr Snippet -> IO (Ptr CChar)
gtk_source_snippet_get_name Ptr Snippet
snippet'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetGetName" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SnippetGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetNameMethodInfo a signature where
    overloadedMethod = snippetGetName

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


#endif

-- method Snippet::get_nth_chunk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "nth"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the nth chunk to get"
--                 , 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_get_nth_chunk" gtk_source_snippet_get_nth_chunk :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    Word32 ->                               -- nth : TBasicType TUInt
    IO (Ptr GtkSource.SnippetChunk.SnippetChunk)

-- | Gets the chunk at /@nth@/.
snippetGetNthChunk ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> Word32
    -- ^ /@nth@/: the nth chunk to get
    -> m GtkSource.SnippetChunk.SnippetChunk
    -- ^ __Returns:__ an t'GI.GtkSource.Objects.SnippetChunk.SnippetChunk'
snippetGetNthChunk :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> Word32 -> m SnippetChunk
snippetGetNthChunk a
snippet Word32
nth = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr SnippetChunk
result <- Ptr Snippet -> Word32 -> IO (Ptr SnippetChunk)
gtk_source_snippet_get_nth_chunk Ptr Snippet
snippet' Word32
nth
    Text -> Ptr SnippetChunk -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetGetNthChunk" 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
GtkSource.SnippetChunk.SnippetChunk) Ptr SnippetChunk
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    SnippetChunk -> IO SnippetChunk
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetChunk
result'

#if defined(ENABLE_OVERLOADING)
data SnippetGetNthChunkMethodInfo
instance (signature ~ (Word32 -> m GtkSource.SnippetChunk.SnippetChunk), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetNthChunkMethodInfo a signature where
    overloadedMethod = snippetGetNthChunk

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


#endif

-- method Snippet::get_trigger
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , 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_get_trigger" gtk_source_snippet_get_trigger :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    IO CString

-- | Gets the trigger for the source snippet.
-- 
-- A trigger is a word that can be expanded into the full snippet when
-- the user presses Tab.
snippetGetTrigger ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ A string or 'P.Nothing'
snippetGetTrigger :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> m (Maybe Text)
snippetGetTrigger a
snippet = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
result <- Ptr Snippet -> IO (Ptr CChar)
gtk_source_snippet_get_trigger Ptr Snippet
snippet'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
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
snippet
    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 SnippetGetTriggerMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsSnippet a) => O.OverloadedMethod SnippetGetTriggerMethodInfo a signature where
    overloadedMethod = snippetGetTrigger

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


#endif

-- method Snippet::set_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the snippet description"
--                 , 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_set_description" gtk_source_snippet_set_description :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    CString ->                              -- description : TBasicType TUTF8
    IO ()

-- | Sets the description for the snippet.
snippetSetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> T.Text
    -- ^ /@description@/: the snippet description
    -> m ()
snippetSetDescription :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> Text -> m ()
snippetSetDescription a
snippet Text
description = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
description' <- Text -> IO (Ptr CChar)
textToCString Text
description
    Ptr Snippet -> Ptr CChar -> IO ()
gtk_source_snippet_set_description Ptr Snippet
snippet' Ptr CChar
description'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
description'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Snippet::set_language_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "language_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the language identifier for the snippet"
--                 , 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_set_language_id" gtk_source_snippet_set_language_id :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    CString ->                              -- language_id : TBasicType TUTF8
    IO ()

-- | Sets the language identifier for the snippet.
-- 
-- This should match the [property/@language@/:id] identifier.
snippetSetLanguageId ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> T.Text
    -- ^ /@languageId@/: the language identifier for the snippet
    -> m ()
snippetSetLanguageId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> Text -> m ()
snippetSetLanguageId a
snippet Text
languageId = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
languageId' <- Text -> IO (Ptr CChar)
textToCString Text
languageId
    Ptr Snippet -> Ptr CChar -> IO ()
gtk_source_snippet_set_language_id Ptr Snippet
snippet' Ptr CChar
languageId'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
languageId'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Snippet::set_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the snippet name" , 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_set_name" gtk_source_snippet_set_name :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Sets the name for the snippet.
snippetSetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> T.Text
    -- ^ /@name@/: the snippet name
    -> m ()
snippetSetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> Text -> m ()
snippetSetName a
snippet Text
name = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
name' <- Text -> IO (Ptr CChar)
textToCString Text
name
    Ptr Snippet -> Ptr CChar -> IO ()
gtk_source_snippet_set_name Ptr Snippet
snippet' Ptr CChar
name'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Snippet::set_trigger
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "snippet"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Snippet" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippet"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trigger"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the trigger word" , 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_set_trigger" gtk_source_snippet_set_trigger :: 
    Ptr Snippet ->                          -- snippet : TInterface (Name {namespace = "GtkSource", name = "Snippet"})
    CString ->                              -- trigger : TBasicType TUTF8
    IO ()

-- | Sets the trigger for the snippet.
snippetSetTrigger ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippet a) =>
    a
    -- ^ /@snippet@/: a t'GI.GtkSource.Objects.Snippet.Snippet'
    -> T.Text
    -- ^ /@trigger@/: the trigger word
    -> m ()
snippetSetTrigger :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippet a) =>
a -> Text -> m ()
snippetSetTrigger a
snippet Text
trigger = 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 Snippet
snippet' <- a -> IO (Ptr Snippet)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
snippet
    Ptr CChar
trigger' <- Text -> IO (Ptr CChar)
textToCString Text
trigger
    Ptr Snippet -> Ptr CChar -> IO ()
gtk_source_snippet_set_trigger Ptr Snippet
snippet' Ptr CChar
trigger'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
snippet
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
trigger'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif