{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The [struct/@gio@/.SettingsSchemaSource] and @GSettingsSchema@ APIs provide a
-- mechanism for advanced control over the loading of schemas and a
-- mechanism for introspecting their content.
-- 
-- Plugin loading systems that wish to provide plugins a way to access
-- settings face the problem of how to make the schemas for these
-- settings visible to GSettings.  Typically, a plugin will want to ship
-- the schema along with itself and it won\'t be installed into the
-- standard system directories for schemas.
-- 
-- [struct/@gio@/.SettingsSchemaSource] provides a mechanism for dealing with this
-- by allowing the creation of a new ‘schema source’ from which schemas can
-- be acquired.  This schema source can then become part of the metadata
-- associated with the plugin and queried whenever the plugin requires
-- access to some settings.
-- 
-- Consider the following example:
-- 
-- 
-- === /c code/
-- >typedef struct
-- >{
-- >   …
-- >   GSettingsSchemaSource *schema_source;
-- >   …
-- >} Plugin;
-- >
-- >Plugin *
-- >initialise_plugin (const gchar *dir)
-- >{
-- >  Plugin *plugin;
-- >
-- >  …
-- >
-- >  plugin->schema_source =
-- >    g_settings_schema_source_new_from_directory (dir,
-- >      g_settings_schema_source_get_default (), FALSE, NULL);
-- >
-- >  …
-- >
-- >  return plugin;
-- >}
-- >
-- >…
-- >
-- >GSettings *
-- >plugin_get_settings (Plugin      *plugin,
-- >                     const gchar *schema_id)
-- >{
-- >  GSettingsSchema *schema;
-- >
-- >  if (schema_id == NULL)
-- >    schema_id = plugin->identifier;
-- >
-- >  schema = g_settings_schema_source_lookup (plugin->schema_source,
-- >                                            schema_id, FALSE);
-- >
-- >  if (schema == NULL)
-- >    {
-- >      … disable the plugin or abort, etc …
-- >    }
-- >
-- >  return g_settings_new_full (schema, NULL, NULL);
-- >}
-- 
-- 
-- The code above shows how hooks should be added to the code that
-- initialises (or enables) the plugin to create the schema source and
-- how an API can be added to the plugin system to provide a convenient
-- way for the plugin to access its settings, using the schemas that it
-- ships.
-- 
-- From the standpoint of the plugin, it would need to ensure that it
-- ships a gschemas.compiled file as part of itself, and then simply do
-- the following:
-- 
-- 
-- === /c code/
-- >{
-- >  GSettings *settings;
-- >  gint some_value;
-- >
-- >  settings = plugin_get_settings (self, NULL);
-- >  some_value = g_settings_get_int (settings, "some-value");
-- >  …
-- >}
-- 
-- 
-- It\'s also possible that the plugin system expects the schema source
-- files (ie: @.gschema.xml@ files) instead of a @gschemas.compiled@ file.
-- In that case, the plugin loading system must compile the schemas for
-- itself before attempting to create the settings source.
-- 
-- /Since: 2.32/

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

module GI.Gio.Structs.SettingsSchema
    ( 

-- * Exported types
    SettingsSchema(..)                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [hasKey]("GI.Gio.Structs.SettingsSchema#g:method:hasKey"), [listChildren]("GI.Gio.Structs.SettingsSchema#g:method:listChildren"), [listKeys]("GI.Gio.Structs.SettingsSchema#g:method:listKeys"), [ref]("GI.Gio.Structs.SettingsSchema#g:method:ref"), [unref]("GI.Gio.Structs.SettingsSchema#g:method:unref").
-- 
-- ==== Getters
-- [getId]("GI.Gio.Structs.SettingsSchema#g:method:getId"), [getKey]("GI.Gio.Structs.SettingsSchema#g:method:getKey"), [getPath]("GI.Gio.Structs.SettingsSchema#g:method:getPath").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveSettingsSchemaMethod             ,
#endif

-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaGetIdMethodInfo           ,
#endif
    settingsSchemaGetId                     ,


-- ** getKey #method:getKey#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaGetKeyMethodInfo          ,
#endif
    settingsSchemaGetKey                    ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaGetPathMethodInfo         ,
#endif
    settingsSchemaGetPath                   ,


-- ** hasKey #method:hasKey#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaHasKeyMethodInfo          ,
#endif
    settingsSchemaHasKey                    ,


-- ** listChildren #method:listChildren#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaListChildrenMethodInfo    ,
#endif
    settingsSchemaListChildren              ,


-- ** listKeys #method:listKeys#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaListKeysMethodInfo        ,
#endif
    settingsSchemaListKeys                  ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaRefMethodInfo             ,
#endif
    settingsSchemaRef                       ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    SettingsSchemaUnrefMethodInfo           ,
#endif
    settingsSchemaUnref                     ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.VariantType as GLib.VariantType
import {-# SOURCE #-} qualified GI.Gio.Structs.SettingsSchemaKey as Gio.SettingsSchemaKey

#else
import {-# SOURCE #-} qualified GI.Gio.Structs.SettingsSchemaKey as Gio.SettingsSchemaKey

#endif

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

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

foreign import ccall "g_settings_schema_get_type" c_g_settings_schema_get_type :: 
    IO GType

type instance O.ParentTypes SettingsSchema = '[]
instance O.HasParentTypes SettingsSchema

instance B.Types.TypedObject SettingsSchema where
    glibType :: IO GType
glibType = IO GType
c_g_settings_schema_get_type

instance B.Types.GBoxed SettingsSchema

-- | Convert 'SettingsSchema' 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 SettingsSchema) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_settings_schema_get_type
    gvalueSet_ :: Ptr GValue -> Maybe SettingsSchema -> IO ()
gvalueSet_ Ptr GValue
gv Maybe SettingsSchema
P.Nothing = Ptr GValue -> Ptr SettingsSchema -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr SettingsSchema
forall a. Ptr a
FP.nullPtr :: FP.Ptr SettingsSchema)
    gvalueSet_ Ptr GValue
gv (P.Just SettingsSchema
obj) = SettingsSchema -> (Ptr SettingsSchema -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr SettingsSchema
obj (Ptr GValue -> Ptr SettingsSchema -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe SettingsSchema)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr SettingsSchema)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr SettingsSchema)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed SettingsSchema ptr
        else return P.Nothing
        
    


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

-- method SettingsSchema::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 "g_settings_schema_get_id" g_settings_schema_get_id :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    IO CString

-- | Get the ID of /@schema@/.
settingsSchemaGetId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> m T.Text
    -- ^ __Returns:__ the ID
settingsSchemaGetId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> m Text
settingsSchemaGetId SettingsSchema
schema = 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
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    result <- g_settings_schema_get_id schema'
    checkUnexpectedReturnNULL "settingsSchemaGetId" result
    result' <- cstringToText result
    touchManagedPtr schema
    return result'

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod SettingsSchemaGetIdMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaGetId

instance O.OverloadedMethodInfo SettingsSchemaGetIdMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaGetId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaGetId"
        })


#endif

-- method SettingsSchema::get_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 name of a key" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "SettingsSchemaKey" })
-- throws : False
-- Skip return : False

foreign import ccall "g_settings_schema_get_key" g_settings_schema_get_key :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Gio.SettingsSchemaKey.SettingsSchemaKey)

-- | Gets the key named /@name@/ from /@schema@/.
-- 
-- It is a programmer error to request a key that does not exist.  See
-- 'GI.Gio.Structs.SettingsSchema.settingsSchemaListKeys'.
-- 
-- /Since: 2.40/
settingsSchemaGetKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> T.Text
    -- ^ /@name@/: the name of a key
    -> m Gio.SettingsSchemaKey.SettingsSchemaKey
    -- ^ __Returns:__ the t'GI.Gio.Structs.SettingsSchemaKey.SettingsSchemaKey' for /@name@/
settingsSchemaGetKey :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> Text -> m SettingsSchemaKey
settingsSchemaGetKey SettingsSchema
schema Text
name = IO SettingsSchemaKey -> m SettingsSchemaKey
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingsSchemaKey -> m SettingsSchemaKey)
-> IO SettingsSchemaKey -> m SettingsSchemaKey
forall a b. (a -> b) -> a -> b
$ do
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    name' <- textToCString name
    result <- g_settings_schema_get_key schema' name'
    checkUnexpectedReturnNULL "settingsSchemaGetKey" result
    result' <- (wrapBoxed Gio.SettingsSchemaKey.SettingsSchemaKey) result
    touchManagedPtr schema
    freeMem name'
    return result'

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaGetKeyMethodInfo
instance (signature ~ (T.Text -> m Gio.SettingsSchemaKey.SettingsSchemaKey), MonadIO m) => O.OverloadedMethod SettingsSchemaGetKeyMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaGetKey

instance O.OverloadedMethodInfo SettingsSchemaGetKeyMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaGetKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaGetKey"
        })


#endif

-- method SettingsSchema::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 "g_settings_schema_get_path" g_settings_schema_get_path :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    IO CString

-- | Gets the path associated with /@schema@/, or 'P.Nothing'.
-- 
-- Schemas may be single-instance or relocatable.  Single-instance
-- schemas correspond to exactly one set of keys in the backend
-- database: those located at the path returned by this function.
-- 
-- Relocatable schemas can be referenced by other schemas and can
-- therefore describe multiple sets of keys at different locations.  For
-- relocatable schemas, this function will return 'P.Nothing'.
-- 
-- /Since: 2.32/
settingsSchemaGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the path of the schema, or 'P.Nothing'
settingsSchemaGetPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> m (Maybe Text)
settingsSchemaGetPath SettingsSchema
schema = 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
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    result <- g_settings_schema_get_path schema'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr schema
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaGetPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod SettingsSchemaGetPathMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaGetPath

instance O.OverloadedMethodInfo SettingsSchemaGetPathMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaGetPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaGetPath"
        })


#endif

-- method SettingsSchema::has_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 name of a key" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_settings_schema_has_key" g_settings_schema_has_key :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks if /@schema@/ has a key named /@name@/.
-- 
-- /Since: 2.40/
settingsSchemaHasKey ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> T.Text
    -- ^ /@name@/: the name of a key
    -> m Bool
    -- ^ __Returns:__ 'P.True' if such a key exists
settingsSchemaHasKey :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> Text -> m Bool
settingsSchemaHasKey SettingsSchema
schema Text
name = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    name' <- textToCString name
    result <- g_settings_schema_has_key schema' name'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr schema
    freeMem name'
    return result'

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaHasKeyMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod SettingsSchemaHasKeyMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaHasKey

instance O.OverloadedMethodInfo SettingsSchemaHasKeyMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaHasKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaHasKey"
        })


#endif

-- method SettingsSchema::list_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 "g_settings_schema_list_children" g_settings_schema_list_children :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    IO (Ptr CString)

-- | Gets the list of children in /@schema@/.
-- 
-- You should free the return value with 'GI.GLib.Functions.strfreev' when you are done
-- with it.
-- 
-- /Since: 2.44/
settingsSchemaListChildren ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> m [T.Text]
    -- ^ __Returns:__ a list of
    --    the children on /@settings@/, in no defined order
settingsSchemaListChildren :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> m [Text]
settingsSchemaListChildren SettingsSchema
schema = 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
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    result <- g_settings_schema_list_children schema'
    checkUnexpectedReturnNULL "settingsSchemaListChildren" result
    result' <- unpackZeroTerminatedUTF8CArray result
    mapZeroTerminatedCArray freeMem result
    freeMem result
    touchManagedPtr schema
    return result'

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaListChildrenMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod SettingsSchemaListChildrenMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaListChildren

instance O.OverloadedMethodInfo SettingsSchemaListChildrenMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaListChildren",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaListChildren"
        })


#endif

-- method SettingsSchema::list_keys
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 "g_settings_schema_list_keys" g_settings_schema_list_keys :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    IO (Ptr CString)

-- | Introspects the list of keys on /@schema@/.
-- 
-- You should probably not be calling this function from \"normal\" code
-- (since you should already know what keys are in your schema).  This
-- function is intended for introspection reasons.
-- 
-- /Since: 2.46/
settingsSchemaListKeys ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> m [T.Text]
    -- ^ __Returns:__ a list
    --   of the keys on /@schema@/, in no defined order
settingsSchemaListKeys :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> m [Text]
settingsSchemaListKeys SettingsSchema
schema = 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
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    result <- g_settings_schema_list_keys schema'
    checkUnexpectedReturnNULL "settingsSchemaListKeys" result
    result' <- unpackZeroTerminatedUTF8CArray result
    mapZeroTerminatedCArray freeMem result
    freeMem result
    touchManagedPtr schema
    return result'

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaListKeysMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod SettingsSchemaListKeysMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaListKeys

instance O.OverloadedMethodInfo SettingsSchemaListKeysMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaListKeys",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaListKeys"
        })


#endif

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

foreign import ccall "g_settings_schema_ref" g_settings_schema_ref :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    IO (Ptr SettingsSchema)

-- | Increase the reference count of /@schema@/, returning a new reference.
-- 
-- /Since: 2.32/
settingsSchemaRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> m SettingsSchema
    -- ^ __Returns:__ a new reference to /@schema@/
settingsSchemaRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> m SettingsSchema
settingsSchemaRef SettingsSchema
schema = IO SettingsSchema -> m SettingsSchema
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SettingsSchema -> m SettingsSchema)
-> IO SettingsSchema -> m SettingsSchema
forall a b. (a -> b) -> a -> b
$ do
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    result <- g_settings_schema_ref schema'
    checkUnexpectedReturnNULL "settingsSchemaRef" result
    result' <- (wrapBoxed SettingsSchema) result
    touchManagedPtr schema
    return result'

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaRefMethodInfo
instance (signature ~ (m SettingsSchema), MonadIO m) => O.OverloadedMethod SettingsSchemaRefMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaRef

instance O.OverloadedMethodInfo SettingsSchemaRefMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaRef"
        })


#endif

-- method SettingsSchema::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "schema"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "SettingsSchema" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GSettingsSchema" , 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 "g_settings_schema_unref" g_settings_schema_unref :: 
    Ptr SettingsSchema ->                   -- schema : TInterface (Name {namespace = "Gio", name = "SettingsSchema"})
    IO ()

-- | Decrease the reference count of /@schema@/, possibly freeing it.
-- 
-- /Since: 2.32/
settingsSchemaUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    SettingsSchema
    -- ^ /@schema@/: a t'GI.Gio.Structs.SettingsSchema.SettingsSchema'
    -> m ()
settingsSchemaUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
SettingsSchema -> m ()
settingsSchemaUnref SettingsSchema
schema = 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
    schema' <- SettingsSchema -> IO (Ptr SettingsSchema)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SettingsSchema
schema
    g_settings_schema_unref schema'
    touchManagedPtr schema
    return ()

#if defined(ENABLE_OVERLOADING)
data SettingsSchemaUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SettingsSchemaUnrefMethodInfo SettingsSchema signature where
    overloadedMethod = settingsSchemaUnref

instance O.OverloadedMethodInfo SettingsSchemaUnrefMethodInfo SettingsSchema where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.SettingsSchema.settingsSchemaUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Structs-SettingsSchema.html#v:settingsSchemaUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSettingsSchemaMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveSettingsSchemaMethod "hasKey" o = SettingsSchemaHasKeyMethodInfo
    ResolveSettingsSchemaMethod "listChildren" o = SettingsSchemaListChildrenMethodInfo
    ResolveSettingsSchemaMethod "listKeys" o = SettingsSchemaListKeysMethodInfo
    ResolveSettingsSchemaMethod "ref" o = SettingsSchemaRefMethodInfo
    ResolveSettingsSchemaMethod "unref" o = SettingsSchemaUnrefMethodInfo
    ResolveSettingsSchemaMethod "getId" o = SettingsSchemaGetIdMethodInfo
    ResolveSettingsSchemaMethod "getKey" o = SettingsSchemaGetKeyMethodInfo
    ResolveSettingsSchemaMethod "getPath" o = SettingsSchemaGetPathMethodInfo
    ResolveSettingsSchemaMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif