{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Provides access to [class/@snippet@/].
-- 
-- @GtkSourceSnippetManager@ is an object which processes snippet description
-- files and creates [class/@snippet@/] objects.
-- 
-- Use @/SnippetManager.get_default/@ to retrieve the default
-- instance of @GtkSourceSnippetManager@.
-- 
-- Use [method/@snippetManager@/.get_snippet] to retrieve snippets for
-- a given snippets.

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

module GI.GtkSource.Objects.SnippetManager
    ( 

-- * Exported types
    SnippetManager(..)                      ,
    IsSnippetManager                        ,
    toSnippetManager                        ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [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"), [listAll]("GI.GtkSource.Objects.SnippetManager#g:method:listAll"), [listGroups]("GI.GtkSource.Objects.SnippetManager#g:method:listGroups"), [listMatching]("GI.GtkSource.Objects.SnippetManager#g:method:listMatching"), [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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSearchPath]("GI.GtkSource.Objects.SnippetManager#g:method:getSearchPath"), [getSnippet]("GI.GtkSource.Objects.SnippetManager#g:method:getSnippet").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSearchPath]("GI.GtkSource.Objects.SnippetManager#g:method:setSearchPath").

#if defined(ENABLE_OVERLOADING)
    ResolveSnippetManagerMethod             ,
#endif

-- ** getDefault #method:getDefault#

    snippetManagerGetDefault                ,


-- ** getSearchPath #method:getSearchPath#

#if defined(ENABLE_OVERLOADING)
    SnippetManagerGetSearchPathMethodInfo   ,
#endif
    snippetManagerGetSearchPath             ,


-- ** getSnippet #method:getSnippet#

#if defined(ENABLE_OVERLOADING)
    SnippetManagerGetSnippetMethodInfo      ,
#endif
    snippetManagerGetSnippet                ,


-- ** listAll #method:listAll#

#if defined(ENABLE_OVERLOADING)
    SnippetManagerListAllMethodInfo         ,
#endif
    snippetManagerListAll                   ,


-- ** listGroups #method:listGroups#

#if defined(ENABLE_OVERLOADING)
    SnippetManagerListGroupsMethodInfo      ,
#endif
    snippetManagerListGroups                ,


-- ** listMatching #method:listMatching#

#if defined(ENABLE_OVERLOADING)
    SnippetManagerListMatchingMethodInfo    ,
#endif
    snippetManagerListMatching              ,


-- ** setSearchPath #method:setSearchPath#

#if defined(ENABLE_OVERLOADING)
    SnippetManagerSetSearchPathMethodInfo   ,
#endif
    snippetManagerSetSearchPath             ,




 -- * Properties


-- ** searchPath #attr:searchPath#
-- | Contains a list of directories to search for files containing snippets (*.snippets).

#if defined(ENABLE_OVERLOADING)
    SnippetManagerSearchPathPropertyInfo    ,
#endif
    clearSnippetManagerSearchPath           ,
    constructSnippetManagerSearchPath       ,
    getSnippetManagerSearchPath             ,
    setSnippetManagerSearchPath             ,
#if defined(ENABLE_OVERLOADING)
    snippetManagerSearchPath                ,
#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.Gio.Interfaces.ListModel as Gio.ListModel
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Snippet as GtkSource.Snippet

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

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

foreign import ccall "gtk_source_snippet_manager_get_type"
    c_gtk_source_snippet_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject SnippetManager where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_snippet_manager_get_type

instance B.Types.GObject SnippetManager

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSnippetManagerMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSnippetManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSnippetManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSnippetManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSnippetManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSnippetManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSnippetManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSnippetManagerMethod "listAll" o = SnippetManagerListAllMethodInfo
    ResolveSnippetManagerMethod "listGroups" o = SnippetManagerListGroupsMethodInfo
    ResolveSnippetManagerMethod "listMatching" o = SnippetManagerListMatchingMethodInfo
    ResolveSnippetManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSnippetManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSnippetManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSnippetManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSnippetManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSnippetManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSnippetManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSnippetManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSnippetManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSnippetManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSnippetManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSnippetManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSnippetManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSnippetManagerMethod "getSearchPath" o = SnippetManagerGetSearchPathMethodInfo
    ResolveSnippetManagerMethod "getSnippet" o = SnippetManagerGetSnippetMethodInfo
    ResolveSnippetManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSnippetManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSnippetManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSnippetManagerMethod "setSearchPath" o = SnippetManagerSetSearchPathMethodInfo
    ResolveSnippetManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@search-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' snippetManager #searchPath
-- @
getSnippetManagerSearchPath :: (MonadIO m, IsSnippetManager o) => o -> m [T.Text]
getSnippetManagerSearchPath :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetManager o) =>
o -> m [Text]
getSnippetManagerSearchPath 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
"getSnippetManagerSearchPath" (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.getObjectPropertyStringArray o
obj String
"search-path"

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

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

-- | Set the value of the “@search-path@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #searchPath
-- @
clearSnippetManagerSearchPath :: (MonadIO m, IsSnippetManager o) => o -> m ()
clearSnippetManagerSearchPath :: forall (m :: * -> *) o.
(MonadIO m, IsSnippetManager o) =>
o -> m ()
clearSnippetManagerSearchPath o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe [Text] -> IO ()
forall a. GObject a => a -> String -> Maybe [Text] -> IO ()
B.Properties.setObjectPropertyStringArray o
obj String
"search-path" (Maybe [Text]
forall a. Maybe a
Nothing :: Maybe [T.Text])

#if defined(ENABLE_OVERLOADING)
data SnippetManagerSearchPathPropertyInfo
instance AttrInfo SnippetManagerSearchPathPropertyInfo where
    type AttrAllowedOps SnippetManagerSearchPathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SnippetManagerSearchPathPropertyInfo = IsSnippetManager
    type AttrSetTypeConstraint SnippetManagerSearchPathPropertyInfo = (~) [T.Text]
    type AttrTransferTypeConstraint SnippetManagerSearchPathPropertyInfo = (~) [T.Text]
    type AttrTransferType SnippetManagerSearchPathPropertyInfo = [T.Text]
    type AttrGetType SnippetManagerSearchPathPropertyInfo = [T.Text]
    type AttrLabel SnippetManagerSearchPathPropertyInfo = "search-path"
    type AttrOrigin SnippetManagerSearchPathPropertyInfo = SnippetManager
    attrGet = getSnippetManagerSearchPath
    attrSet = setSnippetManagerSearchPath
    attrTransfer _ v = do
        return v
    attrConstruct = constructSnippetManagerSearchPath
    attrClear = clearSnippetManagerSearchPath
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.SnippetManager.searchPath"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.0/docs/GI-GtkSource-Objects-SnippetManager.html#g:attr:searchPath"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList SnippetManager
type instance O.AttributeList SnippetManager = SnippetManagerAttributeList
type SnippetManagerAttributeList = ('[ '("searchPath", SnippetManagerSearchPathPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
snippetManagerSearchPath :: AttrLabelProxy "searchPath"
snippetManagerSearchPath = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_source_snippet_manager_get_search_path" gtk_source_snippet_manager_get_search_path :: 
    Ptr SnippetManager ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetManager"})
    IO (Ptr CString)

-- | Gets the list directories where /@self@/ looks for snippet files.
snippetManagerGetSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetManager a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetManager.SnippetManager'.
    -> m [T.Text]
    -- ^ __Returns:__ 'P.Nothing'-terminated array
    --   containing a list of snippet files directories.
    --   The array is owned by /@lm@/ and must not be modified.
snippetManagerGetSearchPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetManager a) =>
a -> m [Text]
snippetManagerGetSearchPath a
self = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetManager
self' <- a -> IO (Ptr SnippetManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr SnippetManager -> IO (Ptr CString)
gtk_source_snippet_manager_get_search_path Ptr SnippetManager
self'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetManagerGetSearchPath" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data SnippetManagerGetSearchPathMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsSnippetManager a) => O.OverloadedMethod SnippetManagerGetSearchPathMethodInfo a signature where
    overloadedMethod = snippetManagerGetSearchPath

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


#endif

-- method SnippetManager::get_snippet
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a group name or %NULL"
--                 , 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 "a #GtkSourceLanguage:id or %NULL"
--                 , 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 for the snippet"
--                 , 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_manager_get_snippet" gtk_source_snippet_manager_get_snippet :: 
    Ptr SnippetManager ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetManager"})
    CString ->                              -- group : TBasicType TUTF8
    CString ->                              -- language_id : TBasicType TUTF8
    CString ->                              -- trigger : TBasicType TUTF8
    IO (Ptr GtkSource.Snippet.Snippet)

-- | Queries the known snippets for the first matching /@group@/, /@languageId@/,
-- and\/or /@trigger@/.
-- 
-- If /@group@/ or /@languageId@/ are 'P.Nothing', they will be ignored.
snippetManagerGetSnippet ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetManager a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetManager.SnippetManager'
    -> Maybe (T.Text)
    -- ^ /@group@/: a group name or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@languageId@/: a [Language:id]("GI.GtkSource.Objects.Language#g:attr:id") or 'P.Nothing'
    -> T.Text
    -- ^ /@trigger@/: the trigger for the snippet
    -> m (Maybe GtkSource.Snippet.Snippet)
    -- ^ __Returns:__ a t'GI.GtkSource.Objects.Snippet.Snippet' or 'P.Nothing' if no
    --   matching snippet was found.
snippetManagerGetSnippet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetManager a) =>
a -> Maybe Text -> Maybe Text -> Text -> m (Maybe Snippet)
snippetManagerGetSnippet a
self Maybe Text
group Maybe Text
languageId Text
trigger = IO (Maybe Snippet) -> m (Maybe Snippet)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Snippet) -> m (Maybe Snippet))
-> IO (Maybe Snippet) -> m (Maybe Snippet)
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetManager
self' <- a -> IO (Ptr SnippetManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeGroup <- case Maybe Text
group of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jGroup -> do
            CString
jGroup' <- Text -> IO CString
textToCString Text
jGroup
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jGroup'
    CString
maybeLanguageId <- case Maybe Text
languageId of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLanguageId -> do
            CString
jLanguageId' <- Text -> IO CString
textToCString Text
jLanguageId
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLanguageId'
    CString
trigger' <- Text -> IO CString
textToCString Text
trigger
    Ptr Snippet
result <- Ptr SnippetManager
-> CString -> CString -> CString -> IO (Ptr Snippet)
gtk_source_snippet_manager_get_snippet Ptr SnippetManager
self' CString
maybeGroup CString
maybeLanguageId CString
trigger'
    Maybe Snippet
maybeResult <- Ptr Snippet -> (Ptr Snippet -> IO Snippet) -> IO (Maybe Snippet)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Snippet
result ((Ptr Snippet -> IO Snippet) -> IO (Maybe Snippet))
-> (Ptr Snippet -> IO Snippet) -> IO (Maybe Snippet)
forall a b. (a -> b) -> a -> b
$ \Ptr Snippet
result' -> do
        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
GtkSource.Snippet.Snippet) Ptr Snippet
result'
        Snippet -> IO Snippet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Snippet
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeGroup
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLanguageId
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
trigger'
    Maybe Snippet -> IO (Maybe Snippet)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Snippet
maybeResult

#if defined(ENABLE_OVERLOADING)
data SnippetManagerGetSnippetMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> T.Text -> m (Maybe GtkSource.Snippet.Snippet)), MonadIO m, IsSnippetManager a) => O.OverloadedMethod SnippetManagerGetSnippetMethodInfo a signature where
    overloadedMethod = snippetManagerGetSnippet

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


#endif

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

foreign import ccall "gtk_source_snippet_manager_list_all" gtk_source_snippet_manager_list_all :: 
    Ptr SnippetManager ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetManager"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets a t'GI.Gio.Interfaces.ListModel.ListModel' of all snippets.
-- 
-- This can be used to get an unfiltered list of all of the snippets
-- known to the snippet manager.
-- 
-- /Since: 5.6/
snippetManagerListAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetManager a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetManager.SnippetManager'
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.ListModel.ListModel' of t'GI.GtkSource.Objects.Snippet.Snippet'
snippetManagerListAll :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetManager a) =>
a -> m ListModel
snippetManagerListAll a
self = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetManager
self' <- a -> IO (Ptr SnippetManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr SnippetManager -> IO (Ptr ListModel)
gtk_source_snippet_manager_list_all Ptr SnippetManager
self'
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetManagerListAll" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
data SnippetManagerListAllMethodInfo
instance (signature ~ (m Gio.ListModel.ListModel), MonadIO m, IsSnippetManager a) => O.OverloadedMethod SnippetManagerListAllMethodInfo a signature where
    overloadedMethod = snippetManagerListAll

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


#endif

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

foreign import ccall "gtk_source_snippet_manager_list_groups" gtk_source_snippet_manager_list_groups :: 
    Ptr SnippetManager ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetManager"})
    IO (Ptr CString)

-- | List all the known groups within the snippet manager.
-- 
-- The result should be freed with 'GI.GLib.Functions.free', and the individual strings are
-- owned by /@self@/ and should never be freed by the caller.
snippetManagerListGroups ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetManager a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetManager.SnippetManager'
    -> m [T.Text]
    -- ^ __Returns:__ 
    --   An array of strings which should be freed with 'GI.GLib.Functions.free'.
snippetManagerListGroups :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetManager a) =>
a -> m [Text]
snippetManagerListGroups a
self = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetManager
self' <- a -> IO (Ptr SnippetManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr SnippetManager -> IO (Ptr CString)
gtk_source_snippet_manager_list_groups Ptr SnippetManager
self'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetManagerListGroups" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data SnippetManagerListGroupsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsSnippetManager a) => O.OverloadedMethod SnippetManagerListGroupsMethodInfo a signature where
    overloadedMethod = snippetManagerListGroups

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


#endif

-- method SnippetManager::list_matching
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a group name or %NULL"
--                 , 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 "a #GtkSourceLanguage:id or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trigger_prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a prefix for a trigger to activate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_snippet_manager_list_matching" gtk_source_snippet_manager_list_matching :: 
    Ptr SnippetManager ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetManager"})
    CString ->                              -- group : TBasicType TUTF8
    CString ->                              -- language_id : TBasicType TUTF8
    CString ->                              -- trigger_prefix : TBasicType TUTF8
    IO (Ptr Gio.ListModel.ListModel)

-- | Queries the known snippets for those matching /@group@/, /@languageId@/, and\/or
-- /@triggerPrefix@/.
-- 
-- If any of these are 'P.Nothing', they will be ignored when filtering the available snippets.
-- 
-- The t'GI.Gio.Interfaces.ListModel.ListModel' only contains information about the available snippets until
-- 'GI.Gio.Interfaces.ListModel.listModelGetItem' is called for a specific snippet. This helps reduce
-- the number of t'GI.GObject.Objects.Object.Object'\'s that are created at runtime to those needed by
-- the calling application.
snippetManagerListMatching ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetManager a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetManager.SnippetManager'
    -> Maybe (T.Text)
    -- ^ /@group@/: a group name or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@languageId@/: a [Language:id]("GI.GtkSource.Objects.Language#g:attr:id") or 'P.Nothing'
    -> Maybe (T.Text)
    -- ^ /@triggerPrefix@/: a prefix for a trigger to activate
    -> m Gio.ListModel.ListModel
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.ListModel.ListModel' of t'GI.GtkSource.Objects.Snippet.Snippet'.
snippetManagerListMatching :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetManager a) =>
a -> Maybe Text -> Maybe Text -> Maybe Text -> m ListModel
snippetManagerListMatching a
self Maybe Text
group Maybe Text
languageId Maybe Text
triggerPrefix = IO ListModel -> m ListModel
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ListModel -> m ListModel) -> IO ListModel -> m ListModel
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetManager
self' <- a -> IO (Ptr SnippetManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeGroup <- case Maybe Text
group of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jGroup -> do
            CString
jGroup' <- Text -> IO CString
textToCString Text
jGroup
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jGroup'
    CString
maybeLanguageId <- case Maybe Text
languageId of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jLanguageId -> do
            CString
jLanguageId' <- Text -> IO CString
textToCString Text
jLanguageId
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jLanguageId'
    CString
maybeTriggerPrefix <- case Maybe Text
triggerPrefix of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTriggerPrefix -> do
            CString
jTriggerPrefix' <- Text -> IO CString
textToCString Text
jTriggerPrefix
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTriggerPrefix'
    Ptr ListModel
result <- Ptr SnippetManager
-> CString -> CString -> CString -> IO (Ptr ListModel)
gtk_source_snippet_manager_list_matching Ptr SnippetManager
self' CString
maybeGroup CString
maybeLanguageId CString
maybeTriggerPrefix
    Text -> Ptr ListModel -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetManagerListMatching" Ptr ListModel
result
    ListModel
result' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeGroup
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeLanguageId
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTriggerPrefix
    ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result'

#if defined(ENABLE_OVERLOADING)
data SnippetManagerListMatchingMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> m Gio.ListModel.ListModel), MonadIO m, IsSnippetManager a) => O.OverloadedMethod SnippetManagerListMatchingMethodInfo a signature where
    overloadedMethod = snippetManagerListMatching

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


#endif

-- method SnippetManager::set_search_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "GtkSource" , name = "SnippetManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceSnippetManager"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dirs"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a %NULL-terminated array of\n  strings or %NULL."
--                 , 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_manager_set_search_path" gtk_source_snippet_manager_set_search_path :: 
    Ptr SnippetManager ->                   -- self : TInterface (Name {namespace = "GtkSource", name = "SnippetManager"})
    Ptr CString ->                          -- dirs : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO ()

-- | Sets the list of directories in which the @GtkSourceSnippetManager@ looks for
-- snippet files.
-- 
-- If /@dirs@/ is 'P.Nothing', the search path is reset to default.
-- 
-- At the moment this function can be called only before the
-- snippet files are loaded for the first time. In practice
-- to set a custom search path for a @GtkSourceSnippetManager@,
-- you have to call this function right after creating it.
snippetManagerSetSearchPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsSnippetManager a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.SnippetManager.SnippetManager'
    -> Maybe ([T.Text])
    -- ^ /@dirs@/: a 'P.Nothing'-terminated array of
    --   strings or 'P.Nothing'.
    -> m ()
snippetManagerSetSearchPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSnippetManager a) =>
a -> Maybe [Text] -> m ()
snippetManagerSetSearchPath a
self Maybe [Text]
dirs = 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 SnippetManager
self' <- a -> IO (Ptr SnippetManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
maybeDirs <- case Maybe [Text]
dirs of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jDirs -> do
            Ptr CString
jDirs' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jDirs
            Ptr CString -> IO (Ptr CString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jDirs'
    Ptr SnippetManager -> Ptr CString -> IO ()
gtk_source_snippet_manager_set_search_path Ptr SnippetManager
self' Ptr CString
maybeDirs
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeDirs
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeDirs
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SnippetManagerSetSearchPathMethodInfo
instance (signature ~ (Maybe ([T.Text]) -> m ()), MonadIO m, IsSnippetManager a) => O.OverloadedMethod SnippetManagerSetSearchPathMethodInfo a signature where
    overloadedMethod = snippetManagerSetSearchPath

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


#endif

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

foreign import ccall "gtk_source_snippet_manager_get_default" gtk_source_snippet_manager_get_default :: 
    IO (Ptr SnippetManager)

-- | Returns the default t'GI.GtkSource.Objects.SnippetManager.SnippetManager' instance.
snippetManagerGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m SnippetManager
    -- ^ __Returns:__ a t'GI.GtkSource.Objects.SnippetManager.SnippetManager' which
    --   is owned by GtkSourceView library and must not be unref\'d.
snippetManagerGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m SnippetManager
snippetManagerGetDefault  = IO SnippetManager -> m SnippetManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SnippetManager -> m SnippetManager)
-> IO SnippetManager -> m SnippetManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr SnippetManager
result <- IO (Ptr SnippetManager)
gtk_source_snippet_manager_get_default
    Text -> Ptr SnippetManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"snippetManagerGetDefault" Ptr SnippetManager
result
    SnippetManager
result' <- ((ManagedPtr SnippetManager -> SnippetManager)
-> Ptr SnippetManager -> IO SnippetManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr SnippetManager -> SnippetManager
SnippetManager) Ptr SnippetManager
result
    SnippetManager -> IO SnippetManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SnippetManager
result'

#if defined(ENABLE_OVERLOADING)
#endif