{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @JsonObject@ is the representation of the object type inside JSON.
-- 
-- A @JsonObject@ contains [struct/@json@/.Node] \"members\", which may contain
-- fundamental types, arrays or other objects; each member of an object is
-- accessed using a unique string, or \"name\".
-- 
-- Since objects can be arbitrarily big, copying them can be expensive; for
-- this reason they are reference counted. You can control the lifetime of
-- a @JsonObject@ using [method/@json@/.Object.ref] and [method/@json@/.Object.unref].
-- 
-- To add or overwrite a member with a given name, use [method/@json@/.Object.set_member].
-- 
-- To extract a member with a given name, use [method/@json@/.Object.get_member].
-- 
-- To retrieve the list of members, use [method/@json@/.Object.get_members].
-- 
-- To retrieve the size of the object (that is, the number of members it has),
-- use [method/@json@/.Object.get_size].

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

module GI.Json.Structs.Object
    ( 

-- * Exported types
    Object(..)                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addMember]("GI.Json.Structs.Object#g:method:addMember"), [dupMember]("GI.Json.Structs.Object#g:method:dupMember"), [equal]("GI.Json.Structs.Object#g:method:equal"), [foreachMember]("GI.Json.Structs.Object#g:method:foreachMember"), [hasMember]("GI.Json.Structs.Object#g:method:hasMember"), [hash]("GI.Json.Structs.Object#g:method:hash"), [isImmutable]("GI.Json.Structs.Object#g:method:isImmutable"), [ref]("GI.Json.Structs.Object#g:method:ref"), [removeMember]("GI.Json.Structs.Object#g:method:removeMember"), [seal]("GI.Json.Structs.Object#g:method:seal"), [unref]("GI.Json.Structs.Object#g:method:unref").
-- 
-- ==== Getters
-- [getArrayMember]("GI.Json.Structs.Object#g:method:getArrayMember"), [getBooleanMember]("GI.Json.Structs.Object#g:method:getBooleanMember"), [getBooleanMemberWithDefault]("GI.Json.Structs.Object#g:method:getBooleanMemberWithDefault"), [getDoubleMember]("GI.Json.Structs.Object#g:method:getDoubleMember"), [getDoubleMemberWithDefault]("GI.Json.Structs.Object#g:method:getDoubleMemberWithDefault"), [getIntMember]("GI.Json.Structs.Object#g:method:getIntMember"), [getIntMemberWithDefault]("GI.Json.Structs.Object#g:method:getIntMemberWithDefault"), [getMember]("GI.Json.Structs.Object#g:method:getMember"), [getMembers]("GI.Json.Structs.Object#g:method:getMembers"), [getNullMember]("GI.Json.Structs.Object#g:method:getNullMember"), [getObjectMember]("GI.Json.Structs.Object#g:method:getObjectMember"), [getSize]("GI.Json.Structs.Object#g:method:getSize"), [getStringMember]("GI.Json.Structs.Object#g:method:getStringMember"), [getStringMemberWithDefault]("GI.Json.Structs.Object#g:method:getStringMemberWithDefault"), [getValues]("GI.Json.Structs.Object#g:method:getValues").
-- 
-- ==== Setters
-- [setArrayMember]("GI.Json.Structs.Object#g:method:setArrayMember"), [setBooleanMember]("GI.Json.Structs.Object#g:method:setBooleanMember"), [setDoubleMember]("GI.Json.Structs.Object#g:method:setDoubleMember"), [setIntMember]("GI.Json.Structs.Object#g:method:setIntMember"), [setMember]("GI.Json.Structs.Object#g:method:setMember"), [setNullMember]("GI.Json.Structs.Object#g:method:setNullMember"), [setObjectMember]("GI.Json.Structs.Object#g:method:setObjectMember"), [setStringMember]("GI.Json.Structs.Object#g:method:setStringMember").

#if defined(ENABLE_OVERLOADING)
    ResolveObjectMethod                     ,
#endif

-- ** addMember #method:addMember#

#if defined(ENABLE_OVERLOADING)
    ObjectAddMemberMethodInfo               ,
#endif
    objectAddMember                         ,


-- ** dupMember #method:dupMember#

#if defined(ENABLE_OVERLOADING)
    ObjectDupMemberMethodInfo               ,
#endif
    objectDupMember                         ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    ObjectEqualMethodInfo                   ,
#endif
    objectEqual                             ,


-- ** foreachMember #method:foreachMember#

#if defined(ENABLE_OVERLOADING)
    ObjectForeachMemberMethodInfo           ,
#endif
    objectForeachMember                     ,


-- ** getArrayMember #method:getArrayMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetArrayMemberMethodInfo          ,
#endif
    objectGetArrayMember                    ,


-- ** getBooleanMember #method:getBooleanMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetBooleanMemberMethodInfo        ,
#endif
    objectGetBooleanMember                  ,


-- ** getBooleanMemberWithDefault #method:getBooleanMemberWithDefault#

#if defined(ENABLE_OVERLOADING)
    ObjectGetBooleanMemberWithDefaultMethodInfo,
#endif
    objectGetBooleanMemberWithDefault       ,


-- ** getDoubleMember #method:getDoubleMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetDoubleMemberMethodInfo         ,
#endif
    objectGetDoubleMember                   ,


-- ** getDoubleMemberWithDefault #method:getDoubleMemberWithDefault#

#if defined(ENABLE_OVERLOADING)
    ObjectGetDoubleMemberWithDefaultMethodInfo,
#endif
    objectGetDoubleMemberWithDefault        ,


-- ** getIntMember #method:getIntMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetIntMemberMethodInfo            ,
#endif
    objectGetIntMember                      ,


-- ** getIntMemberWithDefault #method:getIntMemberWithDefault#

#if defined(ENABLE_OVERLOADING)
    ObjectGetIntMemberWithDefaultMethodInfo ,
#endif
    objectGetIntMemberWithDefault           ,


-- ** getMember #method:getMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetMemberMethodInfo               ,
#endif
    objectGetMember                         ,


-- ** getMembers #method:getMembers#

#if defined(ENABLE_OVERLOADING)
    ObjectGetMembersMethodInfo              ,
#endif
    objectGetMembers                        ,


-- ** getNullMember #method:getNullMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetNullMemberMethodInfo           ,
#endif
    objectGetNullMember                     ,


-- ** getObjectMember #method:getObjectMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetObjectMemberMethodInfo         ,
#endif
    objectGetObjectMember                   ,


-- ** getSize #method:getSize#

#if defined(ENABLE_OVERLOADING)
    ObjectGetSizeMethodInfo                 ,
#endif
    objectGetSize                           ,


-- ** getStringMember #method:getStringMember#

#if defined(ENABLE_OVERLOADING)
    ObjectGetStringMemberMethodInfo         ,
#endif
    objectGetStringMember                   ,


-- ** getStringMemberWithDefault #method:getStringMemberWithDefault#

#if defined(ENABLE_OVERLOADING)
    ObjectGetStringMemberWithDefaultMethodInfo,
#endif
    objectGetStringMemberWithDefault        ,


-- ** getValues #method:getValues#

#if defined(ENABLE_OVERLOADING)
    ObjectGetValuesMethodInfo               ,
#endif
    objectGetValues                         ,


-- ** hasMember #method:hasMember#

#if defined(ENABLE_OVERLOADING)
    ObjectHasMemberMethodInfo               ,
#endif
    objectHasMember                         ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    ObjectHashMethodInfo                    ,
#endif
    objectHash                              ,


-- ** isImmutable #method:isImmutable#

#if defined(ENABLE_OVERLOADING)
    ObjectIsImmutableMethodInfo             ,
#endif
    objectIsImmutable                       ,


-- ** new #method:new#

    objectNew                               ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ObjectRefMethodInfo                     ,
#endif
    objectRef                               ,


-- ** removeMember #method:removeMember#

#if defined(ENABLE_OVERLOADING)
    ObjectRemoveMemberMethodInfo            ,
#endif
    objectRemoveMember                      ,


-- ** seal #method:seal#

#if defined(ENABLE_OVERLOADING)
    ObjectSealMethodInfo                    ,
#endif
    objectSeal                              ,


-- ** setArrayMember #method:setArrayMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetArrayMemberMethodInfo          ,
#endif
    objectSetArrayMember                    ,


-- ** setBooleanMember #method:setBooleanMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetBooleanMemberMethodInfo        ,
#endif
    objectSetBooleanMember                  ,


-- ** setDoubleMember #method:setDoubleMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetDoubleMemberMethodInfo         ,
#endif
    objectSetDoubleMember                   ,


-- ** setIntMember #method:setIntMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetIntMemberMethodInfo            ,
#endif
    objectSetIntMember                      ,


-- ** setMember #method:setMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetMemberMethodInfo               ,
#endif
    objectSetMember                         ,


-- ** setNullMember #method:setNullMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetNullMemberMethodInfo           ,
#endif
    objectSetNullMember                     ,


-- ** setObjectMember #method:setObjectMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetObjectMemberMethodInfo         ,
#endif
    objectSetObjectMember                   ,


-- ** setStringMember #method:setStringMember#

#if defined(ENABLE_OVERLOADING)
    ObjectSetStringMemberMethodInfo         ,
#endif
    objectSetStringMember                   ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ObjectUnrefMethodInfo                   ,
#endif
    objectUnref                             ,




    ) 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.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.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.Json.Callbacks as Json.Callbacks
import {-# SOURCE #-} qualified GI.Json.Structs.Array as Json.Array
import {-# SOURCE #-} qualified GI.Json.Structs.Node as Json.Node

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

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

foreign import ccall "json_object_get_type" c_json_object_get_type :: 
    IO GType

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

instance B.Types.TypedObject Object where
    glibType :: IO GType
glibType = IO GType
c_json_object_get_type

instance B.Types.GBoxed Object

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Object
type instance O.AttributeList Object = ObjectAttributeList
type ObjectAttributeList = ('[ ] :: [(Symbol, *)])
#endif

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

foreign import ccall "json_object_new" json_object_new :: 
    IO (Ptr Object)

-- | Creates a new object.
objectNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Object
    -- ^ __Returns:__ the newly created object
objectNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Object
objectNew  = IO Object -> m Object
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
result <- IO (Ptr Object)
json_object_new
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectNew" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Object -> Object
Object) Ptr Object
result
    Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Object::add_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_add_member" json_object_add_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    Ptr Json.Node.Node ->                   -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO ()

{-# DEPRECATED objectAddMember ["(Since version 0.8)","Use [method/@json@/.Object.set_member] instead"] #-}
-- | Adds a new member for the given name and value into an object.
-- 
-- This function will return if the object already contains a member
-- with the same name.
objectAddMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Json.Node.Node
    -- ^ /@node@/: the value of the member
    -> m ()
objectAddMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Node -> m ()
objectAddMember Object
object Text
memberName Node
node = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Node
node
    Ptr Object -> CString -> Ptr Node -> IO ()
json_object_add_member Ptr Object
object' CString
memberName' Ptr Node
node'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectAddMemberMethodInfo
instance (signature ~ (T.Text -> Json.Node.Node -> m ()), MonadIO m) => O.OverloadedMethod ObjectAddMemberMethodInfo Object signature where
    overloadedMethod = objectAddMember

instance O.OverloadedMethodInfo ObjectAddMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectAddMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectAddMember"
        })


#endif

-- method Object::dup_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the JSON object member to access"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : False
-- Skip return : False

foreign import ccall "json_object_dup_member" json_object_dup_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO (Ptr Json.Node.Node)

-- | Retrieves a copy of the value of the given member inside an object.
-- 
-- /Since: 0.6/
objectDupMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the JSON object member to access
    -> m (Maybe Json.Node.Node)
    -- ^ __Returns:__ a copy of the value for the
    --   requested object member
objectDupMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m (Maybe Node)
objectDupMember Object
object Text
memberName = IO (Maybe Node) -> m (Maybe Node)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Node) -> m (Maybe Node))
-> IO (Maybe Node) -> m (Maybe Node)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Node
result <- Ptr Object -> CString -> IO (Ptr Node)
json_object_dup_member Ptr Object
object' CString
memberName'
    Maybe Node
maybeResult <- Ptr Node -> (Ptr Node -> IO Node) -> IO (Maybe Node)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Node
result ((Ptr Node -> IO Node) -> IO (Maybe Node))
-> (Ptr Node -> IO Node) -> IO (Maybe Node)
forall a b. (a -> b) -> a -> b
$ \Ptr Node
result' -> do
        Node
result'' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result'
        Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result''
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Maybe Node -> IO (Maybe Node)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Node
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectDupMemberMethodInfo
instance (signature ~ (T.Text -> m (Maybe Json.Node.Node)), MonadIO m) => O.OverloadedMethod ObjectDupMemberMethodInfo Object signature where
    overloadedMethod = objectDupMember

instance O.OverloadedMethodInfo ObjectDupMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectDupMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectDupMember"
        })


#endif

-- method Object::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another JSON object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_equal" json_object_equal :: 
    Ptr Object ->                           -- a : TInterface (Name {namespace = "Json", name = "Object"})
    Ptr Object ->                           -- b : TInterface (Name {namespace = "Json", name = "Object"})
    IO CInt

-- | Check whether /@a@/ and /@b@/ are equal objects, meaning they have the same
-- set of members, and the values of corresponding members are equal.
-- 
-- /Since: 1.2/
objectEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@a@/: a JSON object
    -> Object
    -- ^ /@b@/: another JSON object
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@a@/ and /@b@/ are equal, and @FALSE@ otherwise
objectEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Object -> m Bool
objectEqual Object
a Object
b = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
a' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
a
    Ptr Object
b' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
b
    CInt
result <- Ptr Object -> Ptr Object -> IO CInt
json_object_equal Ptr Object
a' Ptr Object
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
a
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectEqualMethodInfo
instance (signature ~ (Object -> m Bool), MonadIO m) => O.OverloadedMethod ObjectEqualMethodInfo Object signature where
    overloadedMethod = objectEqual

instance O.OverloadedMethodInfo ObjectEqualMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectEqual"
        })


#endif

-- method Object::foreach_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "ObjectForeach" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to be called on each member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_foreach_member" json_object_foreach_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    FunPtr Json.Callbacks.C_ObjectForeach -> -- func : TInterface (Name {namespace = "Json", name = "ObjectForeach"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO ()

-- | Iterates over all members of /@object@/ and calls /@func@/ on
-- each one of them.
-- 
-- It is safe to change the value of a member of the oobject
-- from within the iterator function, but it is not safe to add or
-- remove members from the object.
-- 
-- The order in which the object members are iterated is the
-- insertion order.
-- 
-- /Since: 0.8/
objectForeachMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> Json.Callbacks.ObjectForeach
    -- ^ /@func@/: the function to be called on each member
    -> m ()
objectForeachMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> ObjectForeach -> m ()
objectForeachMember Object
object ObjectForeach
func = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    FunPtr C_ObjectForeach
func' <- C_ObjectForeach -> IO (FunPtr C_ObjectForeach)
Json.Callbacks.mk_ObjectForeach (Maybe (Ptr (FunPtr C_ObjectForeach))
-> ObjectForeach_WithClosures -> C_ObjectForeach
Json.Callbacks.wrap_ObjectForeach Maybe (Ptr (FunPtr C_ObjectForeach))
forall a. Maybe a
Nothing (ObjectForeach -> ObjectForeach_WithClosures
Json.Callbacks.drop_closures_ObjectForeach ObjectForeach
func))
    let data_ :: Ptr a
data_ = Ptr a
forall a. Ptr a
nullPtr
    Ptr Object -> FunPtr C_ObjectForeach -> Ptr () -> IO ()
json_object_foreach_member Ptr Object
object' FunPtr C_ObjectForeach
func' Ptr ()
forall a. Ptr a
data_
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ObjectForeach -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ObjectForeach
func'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectForeachMemberMethodInfo
instance (signature ~ (Json.Callbacks.ObjectForeach -> m ()), MonadIO m) => O.OverloadedMethod ObjectForeachMemberMethodInfo Object signature where
    overloadedMethod = objectForeachMember

instance O.OverloadedMethodInfo ObjectForeachMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectForeachMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectForeachMember"
        })


#endif

-- method Object::get_array_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Array" })
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_array_member" json_object_get_array_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO (Ptr Json.Array.Array)

-- | Convenience function that retrieves the array
-- stored in /@memberName@/ of /@object@/. It is an error to specify a
-- /@memberName@/ which does not exist.
-- 
-- If /@memberName@/ contains @null@, then this function will return @NULL@.
-- 
-- See also: [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetArrayMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m (Maybe Json.Array.Array)
    -- ^ __Returns:__ the array inside the object\'s member
objectGetArrayMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m (Maybe Array)
objectGetArrayMember Object
object Text
memberName = IO (Maybe Array) -> m (Maybe Array)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Array) -> m (Maybe Array))
-> IO (Maybe Array) -> m (Maybe Array)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Array
result <- Ptr Object -> CString -> IO (Ptr Array)
json_object_get_array_member Ptr Object
object' CString
memberName'
    Maybe Array
maybeResult <- Ptr Array -> (Ptr Array -> IO Array) -> IO (Maybe Array)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Array
result ((Ptr Array -> IO Array) -> IO (Maybe Array))
-> (Ptr Array -> IO Array) -> IO (Maybe Array)
forall a b. (a -> b) -> a -> b
$ \Ptr Array
result' -> do
        Array
result'' <- ((ManagedPtr Array -> Array) -> Ptr Array -> IO Array
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Array -> Array
Json.Array.Array) Ptr Array
result'
        Array -> IO Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result''
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Maybe Array -> IO (Maybe Array)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Array
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetArrayMemberMethodInfo
instance (signature ~ (T.Text -> m (Maybe Json.Array.Array)), MonadIO m) => O.OverloadedMethod ObjectGetArrayMemberMethodInfo Object signature where
    overloadedMethod = objectGetArrayMember

instance O.OverloadedMethodInfo ObjectGetArrayMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetArrayMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetArrayMember"
        })


#endif

-- method Object::get_boolean_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_boolean_member" json_object_get_boolean_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO CInt

-- | Convenience function that retrieves the boolean value
-- stored in /@memberName@/ of /@object@/. It is an error to specify a
-- /@memberName@/ which does not exist.
-- 
-- See also: [method/@json@/.Object.get_boolean_member_with_default],
--   [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetBooleanMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m Bool
    -- ^ __Returns:__ the boolean value of the object\'s member
objectGetBooleanMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m Bool
objectGetBooleanMember Object
object Text
memberName = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CInt
result <- Ptr Object -> CString -> IO CInt
json_object_get_boolean_member Ptr Object
object' CString
memberName'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo ObjectGetBooleanMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetBooleanMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetBooleanMember"
        })


#endif

-- method Object::get_boolean_member_with_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the @object member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the value to return if @member_name is not valid"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_boolean_member_with_default" json_object_get_boolean_member_with_default :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    CInt ->                                 -- default_value : TBasicType TBoolean
    IO CInt

-- | Convenience function that retrieves the boolean value
-- stored in /@memberName@/ of /@object@/.
-- 
-- If /@memberName@/ does not exist, does not contain a scalar value,
-- or contains @null@, then /@defaultValue@/ is returned instead.
-- 
-- /Since: 1.6/
objectGetBooleanMemberWithDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the /@object@/ member
    -> Bool
    -- ^ /@defaultValue@/: the value to return if /@memberName@/ is not valid
    -> m Bool
    -- ^ __Returns:__ the boolean value of the object\'s member, or the
    --   given default
objectGetBooleanMemberWithDefault :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Bool -> m Bool
objectGetBooleanMemberWithDefault Object
object Text
memberName Bool
defaultValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    let defaultValue' :: CInt
defaultValue' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
defaultValue
    CInt
result <- Ptr Object -> CString -> CInt -> IO CInt
json_object_get_boolean_member_with_default Ptr Object
object' CString
memberName' CInt
defaultValue'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo ObjectGetBooleanMemberWithDefaultMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetBooleanMemberWithDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetBooleanMemberWithDefault"
        })


#endif

-- method Object::get_double_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_double_member" json_object_get_double_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO CDouble

-- | Convenience function that retrieves the floating point value
-- stored in /@memberName@/ of /@object@/. It is an error to specify a
-- /@memberName@/ which does not exist.
-- 
-- See also: [method/@json@/.Object.get_double_member_with_default],
--   [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetDoubleMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m Double
    -- ^ __Returns:__ the floating point value of the object\'s member
objectGetDoubleMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m Double
objectGetDoubleMember Object
object Text
memberName = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CDouble
result <- Ptr Object -> CString -> IO CDouble
json_object_get_double_member Ptr Object
object' CString
memberName'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ObjectGetDoubleMemberMethodInfo
instance (signature ~ (T.Text -> m Double), MonadIO m) => O.OverloadedMethod ObjectGetDoubleMemberMethodInfo Object signature where
    overloadedMethod = objectGetDoubleMember

instance O.OverloadedMethodInfo ObjectGetDoubleMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetDoubleMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetDoubleMember"
        })


#endif

-- method Object::get_double_member_with_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the @object member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the value to return if @member_name is not valid"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_double_member_with_default" json_object_get_double_member_with_default :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    CDouble ->                              -- default_value : TBasicType TDouble
    IO CDouble

-- | Convenience function that retrieves the floating point value
-- stored in /@memberName@/ of /@object@/.
-- 
-- If /@memberName@/ does not exist, does not contain a scalar value,
-- or contains @null@, then /@defaultValue@/ is returned instead.
-- 
-- /Since: 1.6/
objectGetDoubleMemberWithDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the /@object@/ member
    -> Double
    -- ^ /@defaultValue@/: the value to return if /@memberName@/ is not valid
    -> m Double
    -- ^ __Returns:__ the floating point value of the object\'s member, or the
    --   given default
objectGetDoubleMemberWithDefault :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Double -> m Double
objectGetDoubleMemberWithDefault Object
object Text
memberName Double
defaultValue = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    let defaultValue' :: CDouble
defaultValue' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
defaultValue
    CDouble
result <- Ptr Object -> CString -> CDouble -> IO CDouble
json_object_get_double_member_with_default Ptr Object
object' CString
memberName' CDouble
defaultValue'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ObjectGetDoubleMemberWithDefaultMethodInfo
instance (signature ~ (T.Text -> Double -> m Double), MonadIO m) => O.OverloadedMethod ObjectGetDoubleMemberWithDefaultMethodInfo Object signature where
    overloadedMethod = objectGetDoubleMemberWithDefault

instance O.OverloadedMethodInfo ObjectGetDoubleMemberWithDefaultMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetDoubleMemberWithDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetDoubleMemberWithDefault"
        })


#endif

-- method Object::get_int_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the object member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_int_member" json_object_get_int_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO Int64

-- | Convenience function that retrieves the integer value
-- stored in /@memberName@/ of /@object@/. It is an error to specify a
-- /@memberName@/ which does not exist.
-- 
-- See also: [method/@json@/.Object.get_int_member_with_default],
--   [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetIntMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the object member
    -> m Int64
    -- ^ __Returns:__ the integer value of the object\'s member
objectGetIntMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m Int64
objectGetIntMember Object
object Text
memberName = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Int64
result <- Ptr Object -> CString -> IO Int64
json_object_get_int_member Ptr Object
object' CString
memberName'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data ObjectGetIntMemberMethodInfo
instance (signature ~ (T.Text -> m Int64), MonadIO m) => O.OverloadedMethod ObjectGetIntMemberMethodInfo Object signature where
    overloadedMethod = objectGetIntMember

instance O.OverloadedMethodInfo ObjectGetIntMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetIntMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetIntMember"
        })


#endif

-- method Object::get_int_member_with_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the object member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the value to return if @member_name is not valid"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_int_member_with_default" json_object_get_int_member_with_default :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    Int64 ->                                -- default_value : TBasicType TInt64
    IO Int64

-- | Convenience function that retrieves the integer value
-- stored in /@memberName@/ of /@object@/.
-- 
-- If /@memberName@/ does not exist, does not contain a scalar value,
-- or contains @null@, then /@defaultValue@/ is returned instead.
-- 
-- /Since: 1.6/
objectGetIntMemberWithDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the object member
    -> Int64
    -- ^ /@defaultValue@/: the value to return if /@memberName@/ is not valid
    -> m Int64
    -- ^ __Returns:__ the integer value of the object\'s member, or the
    --   given default
objectGetIntMemberWithDefault :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Int64 -> m Int64
objectGetIntMemberWithDefault Object
object Text
memberName Int64
defaultValue = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Int64
result <- Ptr Object -> CString -> Int64 -> IO Int64
json_object_get_int_member_with_default Ptr Object
object' CString
memberName' Int64
defaultValue
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data ObjectGetIntMemberWithDefaultMethodInfo
instance (signature ~ (T.Text -> Int64 -> m Int64), MonadIO m) => O.OverloadedMethod ObjectGetIntMemberWithDefaultMethodInfo Object signature where
    overloadedMethod = objectGetIntMemberWithDefault

instance O.OverloadedMethodInfo ObjectGetIntMemberWithDefaultMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetIntMemberWithDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetIntMemberWithDefault"
        })


#endif

-- method Object::get_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the JSON object member to access"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Node" })
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_member" json_object_get_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO (Ptr Json.Node.Node)

-- | Retrieves the value of the given member inside an object.
objectGetMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the JSON object member to access
    -> m (Maybe Json.Node.Node)
    -- ^ __Returns:__ the value for the
    --   requested object member
objectGetMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m (Maybe Node)
objectGetMember Object
object Text
memberName = IO (Maybe Node) -> m (Maybe Node)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Node) -> m (Maybe Node))
-> IO (Maybe Node) -> m (Maybe Node)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Node
result <- Ptr Object -> CString -> IO (Ptr Node)
json_object_get_member Ptr Object
object' CString
memberName'
    Maybe Node
maybeResult <- Ptr Node -> (Ptr Node -> IO Node) -> IO (Maybe Node)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Node
result ((Ptr Node -> IO Node) -> IO (Maybe Node))
-> (Ptr Node -> IO Node) -> IO (Maybe Node)
forall a b. (a -> b) -> a -> b
$ \Ptr Node
result' -> do
        Node
result'' <- ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Node -> Node
Json.Node.Node) Ptr Node
result'
        Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result''
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Maybe Node -> IO (Maybe Node)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Node
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetMemberMethodInfo
instance (signature ~ (T.Text -> m (Maybe Json.Node.Node)), MonadIO m) => O.OverloadedMethod ObjectGetMemberMethodInfo Object signature where
    overloadedMethod = objectGetMember

instance O.OverloadedMethodInfo ObjectGetMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetMember"
        })


#endif

-- method Object::get_members
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_members" json_object_get_members :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO (Ptr (GList CString))

-- | Retrieves all the names of the members of an object.
-- 
-- You can obtain the value for each member by iterating the returned list
-- and calling [method/@json@/.Object.get_member].
objectGetMembers ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m [T.Text]
    -- ^ __Returns:__ the
    --   member names of the object
objectGetMembers :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> m [Text]
objectGetMembers Object
object = IO [Text] -> m [Text]
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 Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    Ptr (GList CString)
result <- Ptr Object -> IO (Ptr (GList CString))
json_object_get_members Ptr Object
object'
    [CString]
result' <- Ptr (GList CString) -> IO [CString]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

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

instance O.OverloadedMethodInfo ObjectGetMembersMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetMembers",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetMembers"
        })


#endif

-- method Object::get_null_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_null_member" json_object_get_null_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO CInt

-- | Convenience function that checks whether the value
-- stored in /@memberName@/ of /@object@/ is null. It is an error to
-- specify a /@memberName@/ which does not exist.
-- 
-- See also: [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetNullMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the value is @null@
objectGetNullMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m Bool
objectGetNullMember Object
object Text
memberName = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CInt
result <- Ptr Object -> CString -> IO CInt
json_object_get_null_member Ptr Object
object' CString
memberName'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo ObjectGetNullMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetNullMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetNullMember"
        })


#endif

-- method Object::get_object_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_object_member" json_object_get_object_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO (Ptr Object)

-- | Convenience function that retrieves the object
-- stored in /@memberName@/ of /@object@/. It is an error to specify a /@memberName@/
-- which does not exist.
-- 
-- If /@memberName@/ contains @null@, then this function will return @NULL@.
-- 
-- See also: [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetObjectMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m (Maybe Object)
    -- ^ __Returns:__ the object inside the object\'s member
objectGetObjectMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m (Maybe Object)
objectGetObjectMember Object
object Text
memberName = IO (Maybe Object) -> m (Maybe Object)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Object) -> m (Maybe Object))
-> IO (Maybe Object) -> m (Maybe Object)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Object
result <- Ptr Object -> CString -> IO (Ptr Object)
json_object_get_object_member Ptr Object
object' CString
memberName'
    Maybe Object
maybeResult <- Ptr Object -> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Object
result ((Ptr Object -> IO Object) -> IO (Maybe Object))
-> (Ptr Object -> IO Object) -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ \Ptr Object
result' -> do
        Object
result'' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Object -> Object
Object) Ptr Object
result'
        Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data ObjectGetObjectMemberMethodInfo
instance (signature ~ (T.Text -> m (Maybe Object)), MonadIO m) => O.OverloadedMethod ObjectGetObjectMemberMethodInfo Object signature where
    overloadedMethod = objectGetObjectMember

instance O.OverloadedMethodInfo ObjectGetObjectMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetObjectMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetObjectMember"
        })


#endif

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

foreign import ccall "json_object_get_size" json_object_get_size :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO Word32

-- | Retrieves the number of members of a JSON object.
objectGetSize ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m Word32
    -- ^ __Returns:__ the number of members
objectGetSize :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> m Word32
objectGetSize Object
object = IO Word32 -> m Word32
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 Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    Word32
result <- Ptr Object -> IO Word32
json_object_get_size Ptr Object
object'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ObjectGetSizeMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ObjectGetSizeMethodInfo Object signature where
    overloadedMethod = objectGetSize

instance O.OverloadedMethodInfo ObjectGetSizeMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetSize"
        })


#endif

-- method Object::get_string_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_string_member" json_object_get_string_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO CString

-- | Convenience function that retrieves the string value
-- stored in /@memberName@/ of /@object@/. It is an error to specify a
-- /@memberName@/ that does not exist.
-- 
-- See also: [method/@json@/.Object.get_string_member_with_default],
--   [method/@json@/.Object.get_member], [method/@json@/.Object.has_member]
-- 
-- /Since: 0.8/
objectGetStringMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m T.Text
    -- ^ __Returns:__ the string value of the object\'s member
objectGetStringMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m Text
objectGetStringMember Object
object Text
memberName = IO Text -> m Text
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 Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CString
result <- Ptr Object -> CString -> IO CString
json_object_get_string_member Ptr Object
object' CString
memberName'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectGetStringMember" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ObjectGetStringMemberMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m) => O.OverloadedMethod ObjectGetStringMemberMethodInfo Object signature where
    overloadedMethod = objectGetStringMember

instance O.OverloadedMethodInfo ObjectGetStringMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetStringMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetStringMember"
        })


#endif

-- method Object::get_string_member_with_default
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the @object member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the value to return if @member_name is not valid"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_string_member_with_default" json_object_get_string_member_with_default :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    CString ->                              -- default_value : TBasicType TUTF8
    IO CString

-- | Convenience function that retrieves the string value
-- stored in /@memberName@/ of /@object@/.
-- 
-- If /@memberName@/ does not exist, does not contain a scalar value,
-- or contains @null@, then /@defaultValue@/ is returned instead.
-- 
-- /Since: 1.6/
objectGetStringMemberWithDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the /@object@/ member
    -> T.Text
    -- ^ /@defaultValue@/: the value to return if /@memberName@/ is not valid
    -> m T.Text
    -- ^ __Returns:__ the string value of the object\'s member, or the
    --   given default
objectGetStringMemberWithDefault :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Text -> m Text
objectGetStringMemberWithDefault Object
object Text
memberName Text
defaultValue = IO Text -> m Text
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 Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CString
defaultValue' <- Text -> IO CString
textToCString Text
defaultValue
    CString
result <- Ptr Object -> CString -> CString -> IO CString
json_object_get_string_member_with_default Ptr Object
object' CString
memberName' CString
defaultValue'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectGetStringMemberWithDefault" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
defaultValue'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ObjectGetStringMemberWithDefaultMethodInfo
instance (signature ~ (T.Text -> T.Text -> m T.Text), MonadIO m) => O.OverloadedMethod ObjectGetStringMemberWithDefaultMethodInfo Object signature where
    overloadedMethod = objectGetStringMemberWithDefault

instance O.OverloadedMethodInfo ObjectGetStringMemberWithDefaultMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetStringMemberWithDefault",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetStringMemberWithDefault"
        })


#endif

-- method Object::get_values
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Json" , name = "Node" }))
-- throws : False
-- Skip return : False

foreign import ccall "json_object_get_values" json_object_get_values :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO (Ptr (GList (Ptr Json.Node.Node)))

-- | Retrieves all the values of the members of an object.
objectGetValues ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m [Json.Node.Node]
    -- ^ __Returns:__ the
    --   member values of the object
objectGetValues :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> m [Node]
objectGetValues Object
object = IO [Node] -> m [Node]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Node] -> m [Node]) -> IO [Node] -> m [Node]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    Ptr (GList (Ptr Node))
result <- Ptr Object -> IO (Ptr (GList (Ptr Node)))
json_object_get_values Ptr Object
object'
    [Ptr Node]
result' <- Ptr (GList (Ptr Node)) -> IO [Ptr Node]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Node))
result
    [Node]
result'' <- (Ptr Node -> IO Node) -> [Ptr Node] -> IO [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Node -> Node
Json.Node.Node) [Ptr Node]
result'
    Ptr (GList (Ptr Node)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Node))
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    [Node] -> IO [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
result''

#if defined(ENABLE_OVERLOADING)
data ObjectGetValuesMethodInfo
instance (signature ~ (m [Json.Node.Node]), MonadIO m) => O.OverloadedMethod ObjectGetValuesMethodInfo Object signature where
    overloadedMethod = objectGetValues

instance O.OverloadedMethodInfo ObjectGetValuesMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectGetValues",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectGetValues"
        })


#endif

-- method Object::has_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of a JSON object member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_has_member" json_object_has_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO CInt

-- | Checks whether /@object@/ has a member named /@memberName@/.
objectHasMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of a JSON object member
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the JSON object has the requested member
objectHasMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m Bool
objectHasMember Object
object Text
memberName = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CInt
result <- Ptr Object -> CString -> IO CInt
json_object_has_member Ptr Object
object' CString
memberName'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo ObjectHasMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectHasMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectHasMember"
        })


#endif

-- method Object::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "key"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object to hash"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "json_object_hash" json_object_hash :: 
    Ptr Object ->                           -- key : TInterface (Name {namespace = "Json", name = "Object"})
    IO Word32

-- | Calculate a hash value for the given /@key@/ (a JSON object).
-- 
-- The hash is calculated over the object and all its members, recursively. If
-- the object is immutable, this is a fast operation; otherwise, it scales
-- proportionally with the number of members in the object.
-- 
-- /Since: 1.2/
objectHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@key@/: a JSON object to hash
    -> m Word32
    -- ^ __Returns:__ hash value for /@key@/
objectHash :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> m Word32
objectHash Object
key = IO Word32 -> m Word32
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 Object
key' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
key
    Word32
result <- Ptr Object -> IO Word32
json_object_hash Ptr Object
key'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
key
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ObjectHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ObjectHashMethodInfo Object signature where
    overloadedMethod = objectHash

instance O.OverloadedMethodInfo ObjectHashMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectHash",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectHash"
        })


#endif

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

foreign import ccall "json_object_is_immutable" json_object_is_immutable :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO CInt

-- | Checks whether the given object has been marked as immutable by calling
-- [method/@json@/.Object.seal] on it.
-- 
-- /Since: 1.2/
objectIsImmutable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the object is immutable
objectIsImmutable :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Object -> m Bool
objectIsImmutable Object
object = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CInt
result <- Ptr Object -> IO CInt
json_object_is_immutable Ptr Object
object'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ObjectIsImmutableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod ObjectIsImmutableMethodInfo Object signature where
    overloadedMethod = objectIsImmutable

instance O.OverloadedMethodInfo ObjectIsImmutableMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectIsImmutable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectIsImmutable"
        })


#endif

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

foreign import ccall "json_object_ref" json_object_ref :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO (Ptr Object)

-- | Acquires a reference on the given object.
objectRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m Object
    -- ^ __Returns:__ the given object, with the reference count
    --   increased by one.
objectRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> m Object
objectRef Object
object = IO Object -> m Object
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    Ptr Object
result <- Ptr Object -> IO (Ptr Object)
json_object_ref Ptr Object
object'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"objectRef" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Object -> Object
Object) Ptr Object
result
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data ObjectRefMethodInfo
instance (signature ~ (m Object), MonadIO m) => O.OverloadedMethod ObjectRefMethodInfo Object signature where
    overloadedMethod = objectRef

instance O.OverloadedMethodInfo ObjectRefMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectRef"
        })


#endif

-- method Object::remove_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_remove_member" json_object_remove_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO ()

-- | Removes /@memberName@/ from /@object@/, freeing its allocated resources.
objectRemoveMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member to remove
    -> m ()
objectRemoveMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m ()
objectRemoveMember Object
object Text
memberName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Object -> CString -> IO ()
json_object_remove_member Ptr Object
object' CString
memberName'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectRemoveMemberMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod ObjectRemoveMemberMethodInfo Object signature where
    overloadedMethod = objectRemoveMember

instance O.OverloadedMethodInfo ObjectRemoveMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectRemoveMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectRemoveMember"
        })


#endif

-- method Object::seal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_seal" json_object_seal :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO ()

-- | Seals the object, making it immutable to further changes.
-- 
-- This function will recursively seal all members of the object too.
-- 
-- If the object is already immutable, this is a no-op.
-- 
-- /Since: 1.2/
objectSeal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m ()
objectSeal :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Object -> m ()
objectSeal Object
object = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    Ptr Object -> IO ()
json_object_seal Ptr Object
object'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSealMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ObjectSealMethodInfo Object signature where
    overloadedMethod = objectSeal

instance O.OverloadedMethodInfo ObjectSealMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSeal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSeal"
        })


#endif

-- method Object::set_array_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_array_member" json_object_set_array_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    Ptr Json.Array.Array ->                 -- value : TInterface (Name {namespace = "Json", name = "Array"})
    IO ()

-- | Convenience function for setting an object member with an array value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.take_array]
-- 
-- /Since: 0.8/
objectSetArrayMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Json.Array.Array
    -- ^ /@value@/: the value of the member
    -> m ()
objectSetArrayMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Array -> m ()
objectSetArrayMember Object
object Text
memberName Array
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Array
value' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Array
value
    Ptr Object -> CString -> Ptr Array -> IO ()
json_object_set_array_member Ptr Object
object' CString
memberName' Ptr Array
value'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetArrayMemberMethodInfo
instance (signature ~ (T.Text -> Json.Array.Array -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetArrayMemberMethodInfo Object signature where
    overloadedMethod = objectSetArrayMember

instance O.OverloadedMethodInfo ObjectSetArrayMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetArrayMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetArrayMember"
        })


#endif

-- method Object::set_boolean_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_boolean_member" json_object_set_boolean_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()

-- | Convenience function for setting an object member with a boolean value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.init_boolean]
-- 
-- /Since: 0.8/
objectSetBooleanMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Bool
    -- ^ /@value@/: the value of the member
    -> m ()
objectSetBooleanMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Bool -> m ()
objectSetBooleanMember Object
object Text
memberName Bool
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    let value' :: CInt
value' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
value
    Ptr Object -> CString -> CInt -> IO ()
json_object_set_boolean_member Ptr Object
object' CString
memberName' CInt
value'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo ObjectSetBooleanMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetBooleanMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetBooleanMember"
        })


#endif

-- method Object::set_double_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_double_member" json_object_set_double_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Convenience function for setting an object member with a floating point value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.init_double]
-- 
-- /Since: 0.8/
objectSetDoubleMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Double
    -- ^ /@value@/: the value of the member
    -> m ()
objectSetDoubleMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Double -> m ()
objectSetDoubleMember Object
object Text
memberName Double
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Object -> CString -> CDouble -> IO ()
json_object_set_double_member Ptr Object
object' CString
memberName' CDouble
value'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetDoubleMemberMethodInfo
instance (signature ~ (T.Text -> Double -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetDoubleMemberMethodInfo Object signature where
    overloadedMethod = objectSetDoubleMember

instance O.OverloadedMethodInfo ObjectSetDoubleMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetDoubleMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetDoubleMember"
        })


#endif

-- method Object::set_int_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_int_member" json_object_set_int_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    Int64 ->                                -- value : TBasicType TInt64
    IO ()

-- | Convenience function for setting an object member with an integer value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.init_int]
-- 
-- /Since: 0.8/
objectSetIntMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Int64
    -- ^ /@value@/: the value of the member
    -> m ()
objectSetIntMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Int64 -> m ()
objectSetIntMember Object
object Text
memberName Int64
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Object -> CString -> Int64 -> IO ()
json_object_set_int_member Ptr Object
object' CString
memberName' Int64
value
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetIntMemberMethodInfo
instance (signature ~ (T.Text -> Int64 -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetIntMemberMethodInfo Object signature where
    overloadedMethod = objectSetIntMember

instance O.OverloadedMethodInfo ObjectSetIntMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetIntMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetIntMember"
        })


#endif

-- method Object::set_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_member" json_object_set_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    Ptr Json.Node.Node ->                   -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO ()

-- | Sets the value of a member inside an object.
-- 
-- If the object does not have a member with the given name, a new member
-- is created.
-- 
-- If the object already has a member with the given name, the current
-- value is overwritten with the new.
-- 
-- /Since: 0.8/
objectSetMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Json.Node.Node
    -- ^ /@node@/: the value of the member
    -> m ()
objectSetMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Node -> m ()
objectSetMember Object
object Text
memberName Node
node = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Node
node
    Ptr Object -> CString -> Ptr Node -> IO ()
json_object_set_member Ptr Object
object' CString
memberName' Ptr Node
node'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetMemberMethodInfo
instance (signature ~ (T.Text -> Json.Node.Node -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetMemberMethodInfo Object signature where
    overloadedMethod = objectSetMember

instance O.OverloadedMethodInfo ObjectSetMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetMember"
        })


#endif

-- method Object::set_null_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_null_member" json_object_set_null_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    IO ()

-- | Convenience function for setting an object member with a @null@ value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.init_null]
-- 
-- /Since: 0.8/
objectSetNullMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> m ()
objectSetNullMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> m ()
objectSetNullMember Object
object Text
memberName = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Object -> CString -> IO ()
json_object_set_null_member Ptr Object
object' CString
memberName'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetNullMemberMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetNullMemberMethodInfo Object signature where
    overloadedMethod = objectSetNullMember

instance O.OverloadedMethodInfo ObjectSetNullMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetNullMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetNullMember"
        })


#endif

-- method Object::set_object_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_object_member" json_object_set_object_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    Ptr Object ->                           -- value : TInterface (Name {namespace = "Json", name = "Object"})
    IO ()

-- | Convenience function for setting an object member with an object value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.take_object]
-- 
-- /Since: 0.8/
objectSetObjectMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> Object
    -- ^ /@value@/: the value of the member
    -> m ()
objectSetObjectMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Object -> m ()
objectSetObjectMember Object
object Text
memberName Object
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    Ptr Object
value' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Object
value
    Ptr Object -> CString -> Ptr Object -> IO ()
json_object_set_object_member Ptr Object
object' CString
memberName' Ptr Object
value'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetObjectMemberMethodInfo
instance (signature ~ (T.Text -> Object -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetObjectMemberMethodInfo Object signature where
    overloadedMethod = objectSetObjectMember

instance O.OverloadedMethodInfo ObjectSetObjectMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetObjectMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetObjectMember"
        })


#endif

-- method Object::set_string_member
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "member_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value of the member"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_set_string_member" json_object_set_string_member :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    CString ->                              -- member_name : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | Convenience function for setting an object member with a string value.
-- 
-- See also: [method/@json@/.Object.set_member], [method/@json@/.Node.init_string]
-- 
-- /Since: 0.8/
objectSetStringMember ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> T.Text
    -- ^ /@memberName@/: the name of the member
    -> T.Text
    -- ^ /@value@/: the value of the member
    -> m ()
objectSetStringMember :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Object -> Text -> Text -> m ()
objectSetStringMember Object
object Text
memberName Text
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    CString
memberName' <- Text -> IO CString
textToCString Text
memberName
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr Object -> CString -> CString -> IO ()
json_object_set_string_member Ptr Object
object' CString
memberName' CString
value'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
memberName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectSetStringMemberMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m) => O.OverloadedMethod ObjectSetStringMemberMethodInfo Object signature where
    overloadedMethod = objectSetStringMember

instance O.OverloadedMethodInfo ObjectSetStringMemberMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectSetStringMember",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectSetStringMember"
        })


#endif

-- method Object::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_object_unref" json_object_unref :: 
    Ptr Object ->                           -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO ()

-- | Releases a reference on the given object.
-- 
-- If the reference count reaches zero, the object is destroyed and
-- all its resources are freed.
objectUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Object
    -- ^ /@object@/: a JSON object
    -> m ()
objectUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Object -> m ()
objectUnref Object
object = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
object
    Ptr Object -> IO ()
json_object_unref Ptr Object
object'
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ObjectUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ObjectUnrefMethodInfo Object signature where
    overloadedMethod = objectUnref

instance O.OverloadedMethodInfo ObjectUnrefMethodInfo Object where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Json.Structs.Object.objectUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-json-1.0.2/docs/GI-Json-Structs-Object.html#v:objectUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveObjectMethod (t :: Symbol) (o :: *) :: * where
    ResolveObjectMethod "addMember" o = ObjectAddMemberMethodInfo
    ResolveObjectMethod "dupMember" o = ObjectDupMemberMethodInfo
    ResolveObjectMethod "equal" o = ObjectEqualMethodInfo
    ResolveObjectMethod "foreachMember" o = ObjectForeachMemberMethodInfo
    ResolveObjectMethod "hasMember" o = ObjectHasMemberMethodInfo
    ResolveObjectMethod "hash" o = ObjectHashMethodInfo
    ResolveObjectMethod "isImmutable" o = ObjectIsImmutableMethodInfo
    ResolveObjectMethod "ref" o = ObjectRefMethodInfo
    ResolveObjectMethod "removeMember" o = ObjectRemoveMemberMethodInfo
    ResolveObjectMethod "seal" o = ObjectSealMethodInfo
    ResolveObjectMethod "unref" o = ObjectUnrefMethodInfo
    ResolveObjectMethod "getArrayMember" o = ObjectGetArrayMemberMethodInfo
    ResolveObjectMethod "getBooleanMember" o = ObjectGetBooleanMemberMethodInfo
    ResolveObjectMethod "getBooleanMemberWithDefault" o = ObjectGetBooleanMemberWithDefaultMethodInfo
    ResolveObjectMethod "getDoubleMember" o = ObjectGetDoubleMemberMethodInfo
    ResolveObjectMethod "getDoubleMemberWithDefault" o = ObjectGetDoubleMemberWithDefaultMethodInfo
    ResolveObjectMethod "getIntMember" o = ObjectGetIntMemberMethodInfo
    ResolveObjectMethod "getIntMemberWithDefault" o = ObjectGetIntMemberWithDefaultMethodInfo
    ResolveObjectMethod "getMember" o = ObjectGetMemberMethodInfo
    ResolveObjectMethod "getMembers" o = ObjectGetMembersMethodInfo
    ResolveObjectMethod "getNullMember" o = ObjectGetNullMemberMethodInfo
    ResolveObjectMethod "getObjectMember" o = ObjectGetObjectMemberMethodInfo
    ResolveObjectMethod "getSize" o = ObjectGetSizeMethodInfo
    ResolveObjectMethod "getStringMember" o = ObjectGetStringMemberMethodInfo
    ResolveObjectMethod "getStringMemberWithDefault" o = ObjectGetStringMemberWithDefaultMethodInfo
    ResolveObjectMethod "getValues" o = ObjectGetValuesMethodInfo
    ResolveObjectMethod "setArrayMember" o = ObjectSetArrayMemberMethodInfo
    ResolveObjectMethod "setBooleanMember" o = ObjectSetBooleanMemberMethodInfo
    ResolveObjectMethod "setDoubleMember" o = ObjectSetDoubleMemberMethodInfo
    ResolveObjectMethod "setIntMember" o = ObjectSetIntMemberMethodInfo
    ResolveObjectMethod "setMember" o = ObjectSetMemberMethodInfo
    ResolveObjectMethod "setNullMember" o = ObjectSetNullMemberMethodInfo
    ResolveObjectMethod "setObjectMember" o = ObjectSetObjectMemberMethodInfo
    ResolveObjectMethod "setStringMember" o = ObjectSetStringMemberMethodInfo
    ResolveObjectMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif