{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A generic container of JSON data types.
-- 
-- @JsonNode@ can contain fundamental types (integers, booleans, floating point
-- numbers, strings) and complex types (arrays and objects).
-- 
-- When parsing a JSON data stream you extract the root node and walk
-- the node tree by retrieving the type of data contained inside the
-- node with the @JSON_NODE_TYPE@ macro. If the node contains a fundamental
-- type you can retrieve a copy of the @GValue@ holding it with the
-- 'GI.Json.Structs.Node.nodeGetValue' function, and then use the @GValue@ API to extract
-- the data; if the node contains a complex type you can retrieve the
-- [struct/@json@/.Object] or the [struct/@json@/.Array] using 'GI.Json.Structs.Node.nodeGetObject'
-- or 'GI.Json.Structs.Node.nodeGetArray' respectively, and then retrieve the nodes
-- they contain.
-- 
-- A @JsonNode@ may be marked as immutable using 'GI.Json.Structs.Node.nodeSeal'. This
-- marks the node and all its descendents as read-only, and means that
-- subsequent calls to setter functions (such as 'GI.Json.Structs.Node.nodeSetArray')
-- on them will abort as a programmer error. By marking a node tree as
-- immutable, it may be referenced in multiple places and its hash value cached
-- for fast lookups, without the possibility of a value deep within the tree
-- changing and affecting hash values. Immutable nodes may be passed to
-- functions which retain a reference to them without needing to take a copy.
-- 
-- A @JsonNode@ supports two types of memory management: @malloc@\/@free@
-- semantics, and reference counting semantics. The two may be mixed to a
-- limited extent: nodes may be allocated (which gives them a reference count
-- of 1), referenced one or more times, unreferenced exactly that number of
-- times (using 'GI.Json.Structs.Node.nodeUnref'), then either unreferenced exactly
-- once more or freed (using 'GI.Json.Structs.Node.nodeFree') to destroy them.
-- The 'GI.Json.Structs.Node.nodeFree' function must not be used when a node might
-- have a reference count not equal to 1. To this end, JSON-GLib uses
-- 'GI.Json.Structs.Node.nodeCopy' and 'GI.Json.Structs.Node.nodeUnref' internally.

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

module GI.Json.Structs.Node
    ( 

-- * Exported types
    Node(..)                                ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.Json.Structs.Node#g:method:copy"), [dupArray]("GI.Json.Structs.Node#g:method:dupArray"), [dupObject]("GI.Json.Structs.Node#g:method:dupObject"), [dupString]("GI.Json.Structs.Node#g:method:dupString"), [equal]("GI.Json.Structs.Node#g:method:equal"), [free]("GI.Json.Structs.Node#g:method:free"), [hash]("GI.Json.Structs.Node#g:method:hash"), [init]("GI.Json.Structs.Node#g:method:init"), [initArray]("GI.Json.Structs.Node#g:method:initArray"), [initBoolean]("GI.Json.Structs.Node#g:method:initBoolean"), [initDouble]("GI.Json.Structs.Node#g:method:initDouble"), [initInt]("GI.Json.Structs.Node#g:method:initInt"), [initNull]("GI.Json.Structs.Node#g:method:initNull"), [initObject]("GI.Json.Structs.Node#g:method:initObject"), [initString]("GI.Json.Structs.Node#g:method:initString"), [isImmutable]("GI.Json.Structs.Node#g:method:isImmutable"), [isNull]("GI.Json.Structs.Node#g:method:isNull"), [ref]("GI.Json.Structs.Node#g:method:ref"), [seal]("GI.Json.Structs.Node#g:method:seal"), [takeArray]("GI.Json.Structs.Node#g:method:takeArray"), [takeObject]("GI.Json.Structs.Node#g:method:takeObject"), [typeName]("GI.Json.Structs.Node#g:method:typeName"), [unref]("GI.Json.Structs.Node#g:method:unref").
-- 
-- ==== Getters
-- [getArray]("GI.Json.Structs.Node#g:method:getArray"), [getBoolean]("GI.Json.Structs.Node#g:method:getBoolean"), [getDouble]("GI.Json.Structs.Node#g:method:getDouble"), [getInt]("GI.Json.Structs.Node#g:method:getInt"), [getNodeType]("GI.Json.Structs.Node#g:method:getNodeType"), [getObject]("GI.Json.Structs.Node#g:method:getObject"), [getParent]("GI.Json.Structs.Node#g:method:getParent"), [getString]("GI.Json.Structs.Node#g:method:getString"), [getValue]("GI.Json.Structs.Node#g:method:getValue"), [getValueType]("GI.Json.Structs.Node#g:method:getValueType").
-- 
-- ==== Setters
-- [setArray]("GI.Json.Structs.Node#g:method:setArray"), [setBoolean]("GI.Json.Structs.Node#g:method:setBoolean"), [setDouble]("GI.Json.Structs.Node#g:method:setDouble"), [setInt]("GI.Json.Structs.Node#g:method:setInt"), [setObject]("GI.Json.Structs.Node#g:method:setObject"), [setParent]("GI.Json.Structs.Node#g:method:setParent"), [setString]("GI.Json.Structs.Node#g:method:setString"), [setValue]("GI.Json.Structs.Node#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveNodeMethod                       ,
#endif

-- ** alloc #method:alloc#

    nodeAlloc                               ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    NodeCopyMethodInfo                      ,
#endif
    nodeCopy                                ,


-- ** dupArray #method:dupArray#

#if defined(ENABLE_OVERLOADING)
    NodeDupArrayMethodInfo                  ,
#endif
    nodeDupArray                            ,


-- ** dupObject #method:dupObject#

#if defined(ENABLE_OVERLOADING)
    NodeDupObjectMethodInfo                 ,
#endif
    nodeDupObject                           ,


-- ** dupString #method:dupString#

#if defined(ENABLE_OVERLOADING)
    NodeDupStringMethodInfo                 ,
#endif
    nodeDupString                           ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    NodeEqualMethodInfo                     ,
#endif
    nodeEqual                               ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    NodeFreeMethodInfo                      ,
#endif
    nodeFree                                ,


-- ** getArray #method:getArray#

#if defined(ENABLE_OVERLOADING)
    NodeGetArrayMethodInfo                  ,
#endif
    nodeGetArray                            ,


-- ** getBoolean #method:getBoolean#

#if defined(ENABLE_OVERLOADING)
    NodeGetBooleanMethodInfo                ,
#endif
    nodeGetBoolean                          ,


-- ** getDouble #method:getDouble#

#if defined(ENABLE_OVERLOADING)
    NodeGetDoubleMethodInfo                 ,
#endif
    nodeGetDouble                           ,


-- ** getInt #method:getInt#

#if defined(ENABLE_OVERLOADING)
    NodeGetIntMethodInfo                    ,
#endif
    nodeGetInt                              ,


-- ** getNodeType #method:getNodeType#

#if defined(ENABLE_OVERLOADING)
    NodeGetNodeTypeMethodInfo               ,
#endif
    nodeGetNodeType                         ,


-- ** getObject #method:getObject#

#if defined(ENABLE_OVERLOADING)
    NodeGetObjectMethodInfo                 ,
#endif
    nodeGetObject                           ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    NodeGetParentMethodInfo                 ,
#endif
    nodeGetParent                           ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    NodeGetStringMethodInfo                 ,
#endif
    nodeGetString                           ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    NodeGetValueMethodInfo                  ,
#endif
    nodeGetValue                            ,


-- ** getValueType #method:getValueType#

#if defined(ENABLE_OVERLOADING)
    NodeGetValueTypeMethodInfo              ,
#endif
    nodeGetValueType                        ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    NodeHashMethodInfo                      ,
#endif
    nodeHash                                ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    NodeInitMethodInfo                      ,
#endif
    nodeInit                                ,


-- ** initArray #method:initArray#

#if defined(ENABLE_OVERLOADING)
    NodeInitArrayMethodInfo                 ,
#endif
    nodeInitArray                           ,


-- ** initBoolean #method:initBoolean#

#if defined(ENABLE_OVERLOADING)
    NodeInitBooleanMethodInfo               ,
#endif
    nodeInitBoolean                         ,


-- ** initDouble #method:initDouble#

#if defined(ENABLE_OVERLOADING)
    NodeInitDoubleMethodInfo                ,
#endif
    nodeInitDouble                          ,


-- ** initInt #method:initInt#

#if defined(ENABLE_OVERLOADING)
    NodeInitIntMethodInfo                   ,
#endif
    nodeInitInt                             ,


-- ** initNull #method:initNull#

#if defined(ENABLE_OVERLOADING)
    NodeInitNullMethodInfo                  ,
#endif
    nodeInitNull                            ,


-- ** initObject #method:initObject#

#if defined(ENABLE_OVERLOADING)
    NodeInitObjectMethodInfo                ,
#endif
    nodeInitObject                          ,


-- ** initString #method:initString#

#if defined(ENABLE_OVERLOADING)
    NodeInitStringMethodInfo                ,
#endif
    nodeInitString                          ,


-- ** isImmutable #method:isImmutable#

#if defined(ENABLE_OVERLOADING)
    NodeIsImmutableMethodInfo               ,
#endif
    nodeIsImmutable                         ,


-- ** isNull #method:isNull#

#if defined(ENABLE_OVERLOADING)
    NodeIsNullMethodInfo                    ,
#endif
    nodeIsNull                              ,


-- ** new #method:new#

    nodeNew                                 ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    NodeRefMethodInfo                       ,
#endif
    nodeRef                                 ,


-- ** seal #method:seal#

#if defined(ENABLE_OVERLOADING)
    NodeSealMethodInfo                      ,
#endif
    nodeSeal                                ,


-- ** setArray #method:setArray#

#if defined(ENABLE_OVERLOADING)
    NodeSetArrayMethodInfo                  ,
#endif
    nodeSetArray                            ,


-- ** setBoolean #method:setBoolean#

#if defined(ENABLE_OVERLOADING)
    NodeSetBooleanMethodInfo                ,
#endif
    nodeSetBoolean                          ,


-- ** setDouble #method:setDouble#

#if defined(ENABLE_OVERLOADING)
    NodeSetDoubleMethodInfo                 ,
#endif
    nodeSetDouble                           ,


-- ** setInt #method:setInt#

#if defined(ENABLE_OVERLOADING)
    NodeSetIntMethodInfo                    ,
#endif
    nodeSetInt                              ,


-- ** setObject #method:setObject#

#if defined(ENABLE_OVERLOADING)
    NodeSetObjectMethodInfo                 ,
#endif
    nodeSetObject                           ,


-- ** setParent #method:setParent#

#if defined(ENABLE_OVERLOADING)
    NodeSetParentMethodInfo                 ,
#endif
    nodeSetParent                           ,


-- ** setString #method:setString#

#if defined(ENABLE_OVERLOADING)
    NodeSetStringMethodInfo                 ,
#endif
    nodeSetString                           ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    NodeSetValueMethodInfo                  ,
#endif
    nodeSetValue                            ,


-- ** takeArray #method:takeArray#

#if defined(ENABLE_OVERLOADING)
    NodeTakeArrayMethodInfo                 ,
#endif
    nodeTakeArray                           ,


-- ** takeObject #method:takeObject#

#if defined(ENABLE_OVERLOADING)
    NodeTakeObjectMethodInfo                ,
#endif
    nodeTakeObject                          ,


-- ** typeName #method:typeName#

#if defined(ENABLE_OVERLOADING)
    NodeTypeNameMethodInfo                  ,
#endif
    nodeTypeName                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    NodeUnrefMethodInfo                     ,
#endif
    nodeUnref                               ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.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 {-# SOURCE #-} qualified GI.Json.Enums as Json.Enums
import {-# SOURCE #-} qualified GI.Json.Structs.Array as Json.Array
import {-# SOURCE #-} qualified GI.Json.Structs.Object as Json.Object

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

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

foreign import ccall "json_node_get_type" c_json_node_get_type :: 
    IO GType

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

instance B.Types.TypedObject Node where
    glibType :: IO GType
glibType = IO GType
c_json_node_get_type

instance B.Types.GBoxed Node

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


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

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

foreign import ccall "json_node_alloc" json_node_alloc :: 
    IO (Ptr Node)

-- | Allocates a new, uninitialized node.
-- 
-- Use 'GI.Json.Structs.Node.nodeInit' and its variants to initialize the returned value.
-- 
-- /Since: 0.16/
nodeAlloc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Node
    -- ^ __Returns:__ the newly allocated node
nodeAlloc :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Node
nodeAlloc  = IO Node -> m Node
forall a. IO a -> m a
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 Node
result <- IO (Ptr Node)
json_node_alloc
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeAlloc" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Node::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "NodeType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of the node to create"
--                 , 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_node_new" json_node_new :: 
    CUInt ->                                -- type : TInterface (Name {namespace = "Json", name = "NodeType"})
    IO (Ptr Node)

-- | Creates a new node holding the given /@type@/.
-- 
-- This is a convenience function for 'GI.Json.Structs.Node.nodeAlloc' and
-- 'GI.Json.Structs.Node.nodeInit', and it\'s the equivalent of:
-- 
-- 
-- === /c code/
-- >   json_node_init (json_node_alloc (), type);
nodeNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Json.Enums.NodeType
    -- ^ /@type@/: the type of the node to create
    -> m Node
    -- ^ __Returns:__ the newly created node
nodeNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
NodeType -> m Node
nodeNew NodeType
type_ = IO Node -> m Node
forall a. IO a -> m a
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
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (NodeType -> Int) -> NodeType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeType -> Int
forall a. Enum a => a -> Int
fromEnum) NodeType
type_
    Ptr Node
result <- CUInt -> IO (Ptr Node)
json_node_new CUInt
type_'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeNew" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Node::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to copy" , 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_node_copy" json_node_copy :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Node)

-- | Copies /@node@/.
-- 
-- If the node contains complex data types, their reference
-- counts are increased, regardless of whether the node is mutable or
-- immutable.
-- 
-- The copy will be immutable if, and only if, /@node@/ is immutable. However,
-- there should be no need to copy an immutable node.
nodeCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to copy
    -> m Node
    -- ^ __Returns:__ the copied of the given node
nodeCopy :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Node
nodeCopy Node
node = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node
result <- Ptr Node -> IO (Ptr Node)
json_node_copy Ptr Node
node'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeCopy" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeCopyMethodInfo
instance (signature ~ (m Node), MonadIO m) => O.OverloadedMethod NodeCopyMethodInfo Node signature where
    overloadedMethod = nodeCopy

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


#endif

-- method Node::dup_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding an array"
--                 , 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_node_dup_array" json_node_dup_array :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Json.Array.Array)

-- | Retrieves the JSON array inside /@node@/.
-- 
-- The reference count of the returned array is increased.
-- 
-- It is a programmer error to call this on a node which doesn’t hold an
-- array value. Use @JSON_NODE_HOLDS_ARRAY@ first.
nodeDupArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding an array
    -> m (Maybe Json.Array.Array)
    -- ^ __Returns:__ the JSON array with its reference
    --   count increased.
nodeDupArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Array)
nodeDupArray Node
node = IO (Maybe Array) -> m (Maybe Array)
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Array
result <- Ptr Node -> IO (Ptr Array)
json_node_dup_array Ptr Node
node'
    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
wrapBoxed ManagedPtr Array -> Array
Json.Array.Array) Ptr Array
result'
        Array -> IO Array
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Array -> IO (Maybe Array)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Array
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeDupArrayMethodInfo
instance (signature ~ (m (Maybe Json.Array.Array)), MonadIO m) => O.OverloadedMethod NodeDupArrayMethodInfo Node signature where
    overloadedMethod = nodeDupArray

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


#endif

-- method Node::dup_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding 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_node_dup_object" json_node_dup_object :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Json.Object.Object)

-- | Retrieves the object inside /@node@/.
-- 
-- The reference count of the returned object is increased.
-- 
-- It is a programmer error to call this on a node which doesn’t hold an
-- object value. Use @JSON_NODE_HOLDS_OBJECT@ first.
nodeDupObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding a JSON object
    -> m (Maybe Json.Object.Object)
    -- ^ __Returns:__ the JSON object
nodeDupObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Object)
nodeDupObject Node
node = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Object
result <- Ptr Node -> IO (Ptr Object)
json_node_dup_object Ptr Node
node'
    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
wrapBoxed ManagedPtr Object -> Object
Json.Object.Object) Ptr Object
result'
        Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeDupObjectMethodInfo
instance (signature ~ (m (Maybe Json.Object.Object)), MonadIO m) => O.OverloadedMethod NodeDupObjectMethodInfo Node signature where
    overloadedMethod = nodeDupObject

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


#endif

-- method Node::dup_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding a string"
--                 , 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_node_dup_string" json_node_dup_string :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CString

-- | Gets a copy of the string value stored inside a node.
-- 
-- If the node does not hold a string value, @NULL@ is returned.
nodeDupString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding a string
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a copy of the string
    --   inside the node
nodeDupString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Text)
nodeDupString Node
node = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CString
result <- Ptr Node -> IO CString
json_node_dup_string Ptr Node
node'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeDupStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod NodeDupStringMethodInfo Node signature where
    overloadedMethod = nodeDupString

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


#endif

-- method Node::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON node" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another JSON node" , 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_node_equal" json_node_equal :: 
    Ptr Node ->                             -- a : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Node ->                             -- b : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Check whether /@a@/ and /@b@/ are equal node, meaning they have the same
-- type and same values (checked recursively).
-- 
-- Note that integer values are compared numerically, ignoring type, so a
-- double value 4.0 is equal to the integer value 4.
-- 
-- /Since: 1.2/
nodeEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@a@/: a JSON node
    -> Node
    -- ^ /@b@/: another JSON node
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@a@/ and /@b@/ are equal; @FALSE@ otherwise
nodeEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Node -> m Bool
nodeEqual Node
a Node
b = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
a' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
a
    Ptr Node
b' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
b
    CInt
result <- Ptr Node -> Ptr Node -> IO CInt
json_node_equal Ptr Node
a' Ptr Node
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
a
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
b
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NodeEqualMethodInfo
instance (signature ~ (Node -> m Bool), MonadIO m) => O.OverloadedMethod NodeEqualMethodInfo Node signature where
    overloadedMethod = nodeEqual

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


#endif

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

foreign import ccall "json_node_free" json_node_free :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO ()

-- | Frees the resources allocated by the node.
nodeFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to free
    -> m ()
nodeFree :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m ()
nodeFree Node
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node -> IO ()
json_node_free Ptr Node
node'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod NodeFreeMethodInfo Node signature where
    overloadedMethod = nodeFree

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


#endif

-- method Node::get_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding an array"
--                 , 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_node_get_array" json_node_get_array :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Json.Array.Array)

-- | Retrieves the JSON array stored inside a node.
-- 
-- It is a programmer error to call this on a node which doesn’t hold an
-- array value. Use @JSON_NODE_HOLDS_ARRAY@ first.
nodeGetArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding an array
    -> m (Maybe Json.Array.Array)
    -- ^ __Returns:__ the JSON array
nodeGetArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Array)
nodeGetArray Node
node = IO (Maybe Array) -> m (Maybe Array)
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Array
result <- Ptr Node -> IO (Ptr Array)
json_node_get_array Ptr Node
node'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Array -> IO (Maybe Array)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Array
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeGetArrayMethodInfo
instance (signature ~ (m (Maybe Json.Array.Array)), MonadIO m) => O.OverloadedMethod NodeGetArrayMethodInfo Node signature where
    overloadedMethod = nodeGetArray

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


#endif

-- method Node::get_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding a boolean value"
--                 , 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_node_get_boolean" json_node_get_boolean :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Gets the boolean value stored inside a node.
-- 
-- If the node holds an integer or double value which is zero, @FALSE@ is
-- returned; otherwise @TRUE@ is returned.
-- 
-- If the node holds a @JSON_NODE_NULL@ value or a value of another
-- non-boolean type, @FALSE@ is returned.
nodeGetBoolean ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding a boolean value
    -> m Bool
    -- ^ __Returns:__ a boolean value.
nodeGetBoolean :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Bool
nodeGetBoolean Node
node = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CInt
result <- Ptr Node -> IO CInt
json_node_get_boolean Ptr Node
node'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NodeGetBooleanMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod NodeGetBooleanMethodInfo Node signature where
    overloadedMethod = nodeGetBoolean

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


#endif

-- method Node::get_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding a floating point value"
--                 , 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_node_get_double" json_node_get_double :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CDouble

-- | Gets the double value stored inside a node.
-- 
-- If the node holds an integer value, it is returned as a double.
-- 
-- If the node holds a @FALSE@ boolean value, @0.0@ is returned; otherwise
-- a non-zero double is returned.
-- 
-- If the node holds a @JSON_NODE_NULL@ value or a value of another
-- non-double type, @0.0@ is returned.
nodeGetDouble ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding a floating point value
    -> m Double
    -- ^ __Returns:__ a double value.
nodeGetDouble :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Double
nodeGetDouble Node
node = IO Double -> m Double
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CDouble
result <- Ptr Node -> IO CDouble
json_node_get_double Ptr Node
node'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data NodeGetDoubleMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod NodeGetDoubleMethodInfo Node signature where
    overloadedMethod = nodeGetDouble

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


#endif

-- method Node::get_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding an integer"
--                 , 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_node_get_int" json_node_get_int :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO Int64

-- | Gets the integer value stored inside a node.
-- 
-- If the node holds a double value, its integer component is returned.
-- 
-- If the node holds a @FALSE@ boolean value, @0@ is returned; otherwise,
-- a non-zero integer is returned.
-- 
-- If the node holds a @JSON_NODE_NULL@ value or a value of another
-- non-integer type, @0@ is returned.
nodeGetInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding an integer
    -> m Int64
    -- ^ __Returns:__ an integer value.
nodeGetInt :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Int64
nodeGetInt Node
node = IO Int64 -> m Int64
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Int64
result <- Ptr Node -> IO Int64
json_node_get_int Ptr Node
node'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Int64 -> IO Int64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data NodeGetIntMethodInfo
instance (signature ~ (m Int64), MonadIO m) => O.OverloadedMethod NodeGetIntMethodInfo Node signature where
    overloadedMethod = nodeGetInt

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


#endif

-- method Node::get_node_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to check" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Json" , name = "NodeType" })
-- throws : False
-- Skip return : False

foreign import ccall "json_node_get_node_type" json_node_get_node_type :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CUInt

-- | Retrieves the type of a /@node@/.
-- 
-- /Since: 0.8/
nodeGetNodeType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to check
    -> m Json.Enums.NodeType
    -- ^ __Returns:__ the type of the node
nodeGetNodeType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m NodeType
nodeGetNodeType Node
node = IO NodeType -> m NodeType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NodeType -> m NodeType) -> IO NodeType -> m NodeType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CUInt
result <- Ptr Node -> IO CUInt
json_node_get_node_type Ptr Node
node'
    let result' :: NodeType
result' = (Int -> NodeType
forall a. Enum a => Int -> a
toEnum (Int -> NodeType) -> (CUInt -> Int) -> CUInt -> NodeType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    NodeType -> IO NodeType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NodeType
result'

#if defined(ENABLE_OVERLOADING)
data NodeGetNodeTypeMethodInfo
instance (signature ~ (m Json.Enums.NodeType), MonadIO m) => O.OverloadedMethod NodeGetNodeTypeMethodInfo Node signature where
    overloadedMethod = nodeGetNodeType

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


#endif

-- method Node::get_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding 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_node_get_object" json_node_get_object :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Json.Object.Object)

-- | Retrieves the object stored inside a node.
-- 
-- It is a programmer error to call this on a node which doesn’t hold an
-- object value. Use @JSON_NODE_HOLDS_OBJECT@ first.
nodeGetObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding a JSON object
    -> m (Maybe Json.Object.Object)
    -- ^ __Returns:__ the JSON object
nodeGetObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Object)
nodeGetObject Node
node = IO (Maybe Object) -> m (Maybe Object)
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Object
result <- Ptr Node -> IO (Ptr Object)
json_node_get_object Ptr Node
node'
    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
Json.Object.Object) Ptr Object
result'
        Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Object
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeGetObjectMethodInfo
instance (signature ~ (m (Maybe Json.Object.Object)), MonadIO m) => O.OverloadedMethod NodeGetObjectMethodInfo Node signature where
    overloadedMethod = nodeGetObject

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


#endif

-- method Node::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to query" , 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_node_get_parent" json_node_get_parent :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Node)

-- | Retrieves the parent node of the given /@node@/.
nodeGetParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to query
    -> m (Maybe Node)
    -- ^ __Returns:__ the parent node, or @NULL@ if /@node@/
    --   is the root node
nodeGetParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Node)
nodeGetParent Node
node = IO (Maybe Node) -> m (Maybe Node)
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node
result <- Ptr Node -> IO (Ptr Node)
json_node_get_parent Ptr Node
node'
    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
Node) Ptr Node
result'
        Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Node -> IO (Maybe Node)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Node
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeGetParentMethodInfo
instance (signature ~ (m (Maybe Node)), MonadIO m) => O.OverloadedMethod NodeGetParentMethodInfo Node signature where
    overloadedMethod = nodeGetParent

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


#endif

-- method Node::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node holding a string"
--                 , 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_node_get_string" json_node_get_string :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CString

-- | Gets the string value stored inside a node.
-- 
-- If the node does not hold a string value, @NULL@ is returned.
nodeGetString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node holding a string
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string value.
nodeGetString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> m (Maybe Text)
nodeGetString Node
node = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CString
result <- Ptr Node -> IO CString
json_node_get_string Ptr Node
node'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data NodeGetStringMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod NodeGetStringMethodInfo Node signature where
    overloadedMethod = nodeGetString

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


#endif

-- method Node::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for an uninitialized value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_get_value" json_node_get_value :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Retrieves a value from a node and copies into /@value@/.
-- 
-- When done using it, call @g_value_unset()@ on the @GValue@ to free the
-- associated resources.
-- 
-- It is a programmer error to call this on a node which doesn’t hold a scalar
-- value. Use @JSON_NODE_HOLDS_VALUE@ first.
nodeGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node
    -> m (GValue)
nodeGetValue :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m GValue
nodeGetValue Node
node = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Node -> Ptr GValue -> IO ()
json_node_get_value Ptr Node
node' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data NodeGetValueMethodInfo
instance (signature ~ (m (GValue)), MonadIO m) => O.OverloadedMethod NodeGetValueMethodInfo Node signature where
    overloadedMethod = nodeGetValue

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


#endif

-- method Node::get_value_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to check" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "json_node_get_value_type" json_node_get_value_type :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CGType

-- | Returns the @GType@ of the payload of the node.
-- 
-- For @JSON_NODE_NULL@ nodes, the returned type is @G_TYPE_INVALID@.
-- 
-- /Since: 0.4/
nodeGetValueType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to check
    -> m GType
    -- ^ __Returns:__ the type for the payload
nodeGetValueType :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m GType
nodeGetValueType Node
node = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CGType
result <- Ptr Node -> IO CGType
json_node_get_value_type Ptr Node
node'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data NodeGetValueTypeMethodInfo
instance (signature ~ (m GType), MonadIO m) => O.OverloadedMethod NodeGetValueTypeMethodInfo Node signature where
    overloadedMethod = nodeGetValueType

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


#endif

-- method Node::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "key"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON node 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_node_hash" json_node_hash :: 
    Ptr Node ->                             -- key : TInterface (Name {namespace = "Json", name = "Node"})
    IO Word32

-- | Calculate a hash value for the given /@key@/.
-- 
-- The hash is calculated over the node and its value, recursively. If the node
-- is immutable, this is a fast operation; otherwise, it scales proportionally
-- with the size of the node’s value (for example, with the number of members
-- in the JSON object if this node contains an object).
-- 
-- /Since: 1.2/
nodeHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@key@/: a JSON node to hash
    -> m Word32
    -- ^ __Returns:__ hash value for /@key@/
nodeHash :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Word32
nodeHash Node
key = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
key' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
key
    Word32
result <- Ptr Node -> IO Word32
json_node_hash Ptr Node
key'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
key
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data NodeHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod NodeHashMethodInfo Node signature where
    overloadedMethod = nodeHash

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


#endif

-- method Node::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "NodeType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of JSON node to initialize @node to"
--                 , 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_node_init" json_node_init :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CUInt ->                                -- type : TInterface (Name {namespace = "Json", name = "NodeType"})
    IO (Ptr Node)

-- | Initializes a /@node@/ to a specific /@type@/.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Json.Enums.NodeType
    -- ^ /@type@/: the type of JSON node to initialize /@node@/ to
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> NodeType -> m Node
nodeInit Node
node NodeType
type_ = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (NodeType -> Int) -> NodeType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeType -> Int
forall a. Enum a => a -> Int
fromEnum) NodeType
type_
    Ptr Node
result <- Ptr Node -> CUInt -> IO (Ptr Node)
json_node_init Ptr Node
node' CUInt
type_'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInit" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeInitMethodInfo
instance (signature ~ (Json.Enums.NodeType -> m Node), MonadIO m) => O.OverloadedMethod NodeInitMethodInfo Node signature where
    overloadedMethod = nodeInit

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


#endif

-- method Node::init_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the JSON array to initialize @node with, or `NULL`"
--                 , 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_node_init_array" json_node_init_array :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Json.Array.Array ->                 -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_ARRAY@ and sets /@array@/ into it.
-- 
-- This function will take a reference on /@array@/.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Maybe (Json.Array.Array)
    -- ^ /@array@/: the JSON array to initialize /@node@/ with, or @NULL@
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Maybe Array -> m Node
nodeInitArray Node
node Maybe Array
array = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Array
maybeArray <- case Maybe Array
array of
        Maybe Array
Nothing -> Ptr Array -> IO (Ptr Array)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Array
forall a. Ptr a
nullPtr
        Just Array
jArray -> do
            Ptr Array
jArray' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
jArray
            Ptr Array -> IO (Ptr Array)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Array
jArray'
    Ptr Node
result <- Ptr Node -> Ptr Array -> IO (Ptr Node)
json_node_init_array Ptr Node
node' Ptr Array
maybeArray
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitArray" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Array -> (Array -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Array
array Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeInitArrayMethodInfo
instance (signature ~ (Maybe (Json.Array.Array) -> m Node), MonadIO m) => O.OverloadedMethod NodeInitArrayMethodInfo Node signature where
    overloadedMethod = nodeInitArray

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


#endif

-- method Node::init_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , 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 "a boolean value" , 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_node_init_boolean" json_node_init_boolean :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CInt ->                                 -- value : TBasicType TBoolean
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_VALUE@ and sets /@value@/ into it.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitBoolean ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Bool
    -- ^ /@value@/: a boolean value
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitBoolean :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Bool -> m Node
nodeInitBoolean Node
node Bool
value = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    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 Node
result <- Ptr Node -> CInt -> IO (Ptr Node)
json_node_init_boolean Ptr Node
node' CInt
value'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitBoolean" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeInitBooleanMethodInfo
instance (signature ~ (Bool -> m Node), MonadIO m) => O.OverloadedMethod NodeInitBooleanMethodInfo Node signature where
    overloadedMethod = nodeInitBoolean

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


#endif

-- method Node::init_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , 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 "a floating point value"
--                 , 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_node_init_double" json_node_init_double :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CDouble ->                              -- value : TBasicType TDouble
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_VALUE@ and sets /@value@/ into it.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitDouble ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Double
    -- ^ /@value@/: a floating point value
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitDouble :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Double -> m Node
nodeInitDouble Node
node Double
value = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Node
result <- Ptr Node -> CDouble -> IO (Ptr Node)
json_node_init_double Ptr Node
node' CDouble
value'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitDouble" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeInitDoubleMethodInfo
instance (signature ~ (Double -> m Node), MonadIO m) => O.OverloadedMethod NodeInitDoubleMethodInfo Node signature where
    overloadedMethod = nodeInitDouble

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


#endif

-- method Node::init_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , 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 "an integer" , 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_node_init_int" json_node_init_int :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Int64 ->                                -- value : TBasicType TInt64
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_VALUE@ and sets /@value@/ into it.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Int64
    -- ^ /@value@/: an integer
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitInt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Int64 -> m Node
nodeInitInt Node
node Int64
value = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node
result <- Ptr Node -> Int64 -> IO (Ptr Node)
json_node_init_int Ptr Node
node' Int64
value
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitInt" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeInitIntMethodInfo
instance (signature ~ (Int64 -> m Node), MonadIO m) => O.OverloadedMethod NodeInitIntMethodInfo Node signature where
    overloadedMethod = nodeInitInt

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


#endif

-- method Node::init_null
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , 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_node_init_null" json_node_init_null :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_NULL@.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitNull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitNull :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Node
nodeInitNull Node
node = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node
result <- Ptr Node -> IO (Ptr Node)
json_node_init_null Ptr Node
node'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitNull" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeInitNullMethodInfo
instance (signature ~ (m Node), MonadIO m) => O.OverloadedMethod NodeInitNullMethodInfo Node signature where
    overloadedMethod = nodeInitNull

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


#endif

-- method Node::init_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the JSON object to initialize @node with, or `NULL`"
--                 , 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_node_init_object" json_node_init_object :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Json.Object.Object ->               -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_OBJECT@ and sets /@object@/ into it.
-- 
-- This function will take a reference on /@object@/.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Maybe (Json.Object.Object)
    -- ^ /@object@/: the JSON object to initialize /@node@/ with, or @NULL@
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Maybe Object -> m Node
nodeInitObject Node
node Maybe Object
object = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Object
maybeObject <- case Maybe Object
object of
        Maybe Object
Nothing -> Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just Object
jObject -> do
            Ptr Object
jObject' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
jObject
            Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jObject'
    Ptr Node
result <- Ptr Node -> Ptr Object -> IO (Ptr Node)
json_node_init_object Ptr Node
node' Ptr Object
maybeObject
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitObject" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Object -> (Object -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Object
object Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

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

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


#endif

-- method Node::init_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to initialize"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string value" , 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_node_init_string" json_node_init_string :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CString ->                              -- value : TBasicType TUTF8
    IO (Ptr Node)

-- | Initializes /@node@/ to @JSON_NODE_VALUE@ and sets /@value@/ into it.
-- 
-- If the node has already been initialized once, it will be reset to
-- the given type, and any data contained will be cleared.
-- 
-- /Since: 0.16/
nodeInitString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to initialize
    -> Maybe (T.Text)
    -- ^ /@value@/: a string value
    -> m Node
    -- ^ __Returns:__ the initialized node
nodeInitString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Maybe Text -> m Node
nodeInitString Node
node Maybe Text
value = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CString
maybeValue <- case Maybe Text
value of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jValue -> do
            CString
jValue' <- Text -> IO CString
textToCString Text
jValue
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jValue'
    Ptr Node
result <- Ptr Node -> CString -> IO (Ptr Node)
json_node_init_string Ptr Node
node' CString
maybeValue
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeInitString" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeValue
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

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

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


#endif

-- method Node::is_immutable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to check" , 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_node_is_immutable" json_node_is_immutable :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Check whether the given /@node@/ has been marked as immutable by calling
-- 'GI.Json.Structs.Node.nodeSeal' on it.
-- 
-- /Since: 1.2/
nodeIsImmutable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to check
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the /@node@/ is immutable
nodeIsImmutable :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Bool
nodeIsImmutable Node
node = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CInt
result <- Ptr Node -> IO CInt
json_node_is_immutable Ptr Node
node'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NodeIsImmutableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod NodeIsImmutableMethodInfo Node signature where
    overloadedMethod = nodeIsImmutable

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


#endif

-- method Node::is_null
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to check" , 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_node_is_null" json_node_is_null :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CInt

-- | Checks whether /@node@/ is a @JSON_NODE_NULL@.
-- 
-- A @JSON_NODE_NULL@ node is not the same as a @NULL@ node; a @JSON_NODE_NULL@
-- represents a literal @null@ value in the JSON tree.
-- 
-- /Since: 0.8/
nodeIsNull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to check
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the node is null
nodeIsNull :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Bool
nodeIsNull Node
node = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CInt
result <- Ptr Node -> IO CInt
json_node_is_null Ptr Node
node'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data NodeIsNullMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod NodeIsNullMethodInfo Node signature where
    overloadedMethod = nodeIsNull

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


#endif

-- method Node::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to reference"
--                 , 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_node_ref" json_node_ref :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO (Ptr Node)

-- | Increments the reference count of /@node@/.
-- 
-- /Since: 1.2/
nodeRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to reference
    -> m Node
    -- ^ __Returns:__ a pointer to /@node@/
nodeRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Node
nodeRef Node
node = IO Node -> m Node
forall a. IO a -> m a
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 Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node
result <- Ptr Node -> IO (Ptr Node)
json_node_ref Ptr Node
node'
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeRef" Ptr Node
result
    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
Node) Ptr Node
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Node -> IO Node
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

#if defined(ENABLE_OVERLOADING)
data NodeRefMethodInfo
instance (signature ~ (m Node), MonadIO m) => O.OverloadedMethod NodeRefMethodInfo Node signature where
    overloadedMethod = nodeRef

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


#endif

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

foreign import ccall "json_node_seal" json_node_seal :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO ()

-- | Seals the given node, making it immutable to further changes.
-- 
-- In order to be sealed, the /@node@/ must have a type and value set. The value
-- will be recursively sealed — if the node holds an object, that JSON object
-- will be sealed, etc.
-- 
-- If the @node@ is already immutable, this is a no-op.
-- 
-- /Since: 1.2/
nodeSeal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to seal
    -> m ()
nodeSeal :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m ()
nodeSeal Node
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node -> IO ()
json_node_seal Ptr Node
node'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSealMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod NodeSealMethodInfo Node signature where
    overloadedMethod = nodeSeal

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


#endif

-- method Node::set_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_ARRAY`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON array" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_array" json_node_set_array :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Json.Array.Array ->                 -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO ()

-- | Sets /@array@/ inside /@node@/.
-- 
-- The reference count of /@array@/ is increased.
-- 
-- It is a programmer error to call this on a node which doesn’t hold an
-- array value. Use @JSON_NODE_HOLDS_ARRAY@ first.
nodeSetArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_ARRAY@
    -> Json.Array.Array
    -- ^ /@array@/: a JSON array
    -> m ()
nodeSetArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Array -> m ()
nodeSetArray Node
node Array
array = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Node -> Ptr Array -> IO ()
json_node_set_array Ptr Node
node' Ptr Array
array'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSetArrayMethodInfo
instance (signature ~ (Json.Array.Array -> m ()), MonadIO m) => O.OverloadedMethod NodeSetArrayMethodInfo Node signature where
    overloadedMethod = nodeSetArray

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


#endif

-- method Node::set_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_VALUE`"
--                 , 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 "a boolean value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_boolean" json_node_set_boolean :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CInt ->                                 -- value : TBasicType TBoolean
    IO ()

-- | Sets /@value@/ as the boolean content of the /@node@/, replacing any existing
-- content.
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- a value node.
nodeSetBoolean ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_VALUE@
    -> Bool
    -- ^ /@value@/: a boolean value
    -> m ()
nodeSetBoolean :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Bool -> m ()
nodeSetBoolean Node
node Bool
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    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 Node -> CInt -> IO ()
json_node_set_boolean Ptr Node
node' CInt
value'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSetBooleanMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod NodeSetBooleanMethodInfo Node signature where
    overloadedMethod = nodeSetBoolean

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


#endif

-- method Node::set_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_VALUE`"
--                 , 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 "a double value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_double" json_node_set_double :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets /@value@/ as the double content of the /@node@/, replacing any existing
-- content.
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- a value node.
nodeSetDouble ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_VALUE@
    -> Double
    -- ^ /@value@/: a double value
    -> m ()
nodeSetDouble :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Double -> m ()
nodeSetDouble Node
node Double
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Node -> CDouble -> IO ()
json_node_set_double Ptr Node
node' CDouble
value'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSetDoubleMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.OverloadedMethod NodeSetDoubleMethodInfo Node signature where
    overloadedMethod = nodeSetDouble

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


#endif

-- method Node::set_int
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_VALUE`"
--                 , 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 "an integer value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_int" json_node_set_int :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Int64 ->                                -- value : TBasicType TInt64
    IO ()

-- | Sets /@value@/ as the integer content of the /@node@/, replacing any existing
-- content.
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- a value node.
nodeSetInt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_VALUE@
    -> Int64
    -- ^ /@value@/: an integer value
    -> m ()
nodeSetInt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Int64 -> m ()
nodeSetInt Node
node Int64
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node -> Int64 -> IO ()
json_node_set_int Ptr Node
node' Int64
value
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSetIntMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.OverloadedMethod NodeSetIntMethodInfo Node signature where
    overloadedMethod = nodeSetInt

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


#endif

-- method Node::set_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_OBJECT`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , 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_node_set_object" json_node_set_object :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Json.Object.Object ->               -- object : TInterface (Name {namespace = "Json", name = "Object"})
    IO ()

-- | Sets /@objects@/ inside /@node@/.
-- 
-- The reference count of /@object@/ is increased.
-- 
-- If /@object@/ is @NULL@, the node’s existing object is cleared.
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- an object node.
nodeSetObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_OBJECT@
    -> Maybe (Json.Object.Object)
    -- ^ /@object@/: a JSON object
    -> m ()
nodeSetObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Maybe Object -> m ()
nodeSetObject Node
node Maybe Object
object = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Object
maybeObject <- case Maybe Object
object of
        Maybe Object
Nothing -> Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just Object
jObject -> do
            Ptr Object
jObject' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Object
jObject
            Ptr Object -> IO (Ptr Object)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jObject'
    Ptr Node -> Ptr Object -> IO ()
json_node_set_object Ptr Node
node' Ptr Object
maybeObject
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Object -> (Object -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Object
object Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Node::set_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the node to change" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent node" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_parent" json_node_set_parent :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Node ->                             -- parent : TInterface (Name {namespace = "Json", name = "Node"})
    IO ()

-- | Sets the parent node for the given @node@.
-- 
-- It is an error to call this with an immutable /@parent@/.
-- 
-- The /@node@/ may be immutable.
-- 
-- /Since: 0.8/
nodeSetParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to change
    -> Maybe (Node)
    -- ^ /@parent@/: the parent node
    -> m ()
nodeSetParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Maybe Node -> m ()
nodeSetParent Node
node Maybe Node
parent = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Node
maybeParent <- case Maybe Node
parent of
        Maybe Node
Nothing -> Ptr Node -> IO (Ptr Node)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Node
forall a. Ptr a
nullPtr
        Just Node
jParent -> do
            Ptr Node
jParent' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
jParent
            Ptr Node -> IO (Ptr Node)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Node
jParent'
    Ptr Node -> Ptr Node -> IO ()
json_node_set_parent Ptr Node
node' Ptr Node
maybeParent
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Maybe Node -> (Node -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Node
parent Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSetParentMethodInfo
instance (signature ~ (Maybe (Node) -> m ()), MonadIO m) => O.OverloadedMethod NodeSetParentMethodInfo Node signature where
    overloadedMethod = nodeSetParent

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


#endif

-- method Node::set_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_VALUE`"
--                 , 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 "a string value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_string" json_node_set_string :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | Sets /@value@/ as the string content of the /@node@/, replacing any existing
-- content.
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- a value node.
nodeSetString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_VALUE@
    -> T.Text
    -- ^ /@value@/: a string value
    -> m ()
nodeSetString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Text -> m ()
nodeSetString Node
node Text
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr Node -> CString -> IO ()
json_node_set_string Ptr Node
node' CString
value'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Node::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_VALUE`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to set" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_set_value" json_node_set_value :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets a scalar value inside the given node.
-- 
-- The contents of the given @GValue@ are copied into the @JsonNode@.
-- 
-- The following @GValue@ types have a direct mapping to JSON types:
-- 
--  - @G_TYPE_INT64@
--  - @G_TYPE_DOUBLE@
--  - @G_TYPE_BOOLEAN@
--  - @G_TYPE_STRING@
-- 
-- JSON-GLib will also automatically promote the following @GValue@ types:
-- 
--  - @G_TYPE_INT@ to @G_TYPE_INT64@
--  - @G_TYPE_FLOAT@ to @G_TYPE_DOUBLE@
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- a value node.
nodeSetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_VALUE@
    -> GValue
    -- ^ /@value@/: the value to set
    -> m ()
nodeSetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> GValue -> m ()
nodeSetValue Node
node GValue
value = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Node -> Ptr GValue -> IO ()
json_node_set_value Ptr Node
node' Ptr GValue
value'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeSetValueMethodInfo
instance (signature ~ (GValue -> m ()), MonadIO m) => O.OverloadedMethod NodeSetValueMethodInfo Node signature where
    overloadedMethod = nodeSetValue

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


#endif

-- method Node::take_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_ARRAY`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JSON array" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_node_take_array" json_node_take_array :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    Ptr Json.Array.Array ->                 -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO ()

-- | Sets /@array@/ inside /@node@/.
-- 
-- The reference count of /@array@/ is not increased.
-- 
-- It is a programmer error to call this on a node which doesn’t hold an
-- array value. Use @JSON_NODE_HOLDS_ARRAY@ first.
nodeTakeArray ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_ARRAY@
    -> Json.Array.Array
    -- ^ /@array@/: a JSON array
    -> m ()
nodeTakeArray :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Array -> m ()
nodeTakeArray Node
node Array
array = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Array
array
    Ptr Node -> Ptr Array -> IO ()
json_node_take_array Ptr Node
node' Ptr Array
array'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeTakeArrayMethodInfo
instance (signature ~ (Json.Array.Array -> m ()), MonadIO m) => O.OverloadedMethod NodeTakeArrayMethodInfo Node signature where
    overloadedMethod = nodeTakeArray

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


#endif

-- method Node::take_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node initialized to `JSON_NODE_OBJECT`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets /@object@/ inside /@node@/.
-- 
-- The reference count of /@object@/ is not increased.
-- 
-- It is an error to call this on an immutable node, or on a node which is not
-- an object node.
nodeTakeObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node initialized to @JSON_NODE_OBJECT@
    -> Json.Object.Object
    -- ^ /@object@/: a JSON object
    -> m ()
nodeTakeObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Node -> Object -> m ()
nodeTakeObject Node
node Object
object = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    Ptr Object
object' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Object
object
    Ptr Node -> Ptr Object -> IO ()
json_node_take_object Ptr Node
node' Ptr Object
object'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Object
object
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Node::type_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "node"
--           , argType = TInterface Name { namespace = "Json" , name = "Node" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a node" , 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_node_type_name" json_node_type_name :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO CString

-- | Retrieves the user readable name of the data type contained by /@node@/.
-- 
-- **Note**: The name is only meant for debugging purposes, and there is no
-- guarantee the name will stay the same across different versions.
nodeTypeName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: a node
    -> m T.Text
    -- ^ __Returns:__ a string containing the name of the type
nodeTypeName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m Text
nodeTypeName Node
node = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Node
node
    CString
result <- Ptr Node -> IO CString
json_node_type_name Ptr Node
node'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"nodeTypeName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data NodeTypeNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod NodeTypeNameMethodInfo Node signature where
    overloadedMethod = nodeTypeName

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


#endif

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

foreign import ccall "json_node_unref" json_node_unref :: 
    Ptr Node ->                             -- node : TInterface (Name {namespace = "Json", name = "Node"})
    IO ()

-- | Decrements the reference count of /@node@/.
-- 
-- If the reference count reaches zero, the node is freed.
-- 
-- /Since: 1.2/
nodeUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Node
    -- ^ /@node@/: the node to unreference
    -> m ()
nodeUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Node -> m ()
nodeUnref Node
node = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Node
node
    Ptr Node -> IO ()
json_node_unref Ptr Node
node'
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data NodeUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod NodeUnrefMethodInfo Node signature where
    overloadedMethod = nodeUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveNodeMethod (t :: Symbol) (o :: *) :: * where
    ResolveNodeMethod "copy" o = NodeCopyMethodInfo
    ResolveNodeMethod "dupArray" o = NodeDupArrayMethodInfo
    ResolveNodeMethod "dupObject" o = NodeDupObjectMethodInfo
    ResolveNodeMethod "dupString" o = NodeDupStringMethodInfo
    ResolveNodeMethod "equal" o = NodeEqualMethodInfo
    ResolveNodeMethod "free" o = NodeFreeMethodInfo
    ResolveNodeMethod "hash" o = NodeHashMethodInfo
    ResolveNodeMethod "init" o = NodeInitMethodInfo
    ResolveNodeMethod "initArray" o = NodeInitArrayMethodInfo
    ResolveNodeMethod "initBoolean" o = NodeInitBooleanMethodInfo
    ResolveNodeMethod "initDouble" o = NodeInitDoubleMethodInfo
    ResolveNodeMethod "initInt" o = NodeInitIntMethodInfo
    ResolveNodeMethod "initNull" o = NodeInitNullMethodInfo
    ResolveNodeMethod "initObject" o = NodeInitObjectMethodInfo
    ResolveNodeMethod "initString" o = NodeInitStringMethodInfo
    ResolveNodeMethod "isImmutable" o = NodeIsImmutableMethodInfo
    ResolveNodeMethod "isNull" o = NodeIsNullMethodInfo
    ResolveNodeMethod "ref" o = NodeRefMethodInfo
    ResolveNodeMethod "seal" o = NodeSealMethodInfo
    ResolveNodeMethod "takeArray" o = NodeTakeArrayMethodInfo
    ResolveNodeMethod "takeObject" o = NodeTakeObjectMethodInfo
    ResolveNodeMethod "typeName" o = NodeTypeNameMethodInfo
    ResolveNodeMethod "unref" o = NodeUnrefMethodInfo
    ResolveNodeMethod "getArray" o = NodeGetArrayMethodInfo
    ResolveNodeMethod "getBoolean" o = NodeGetBooleanMethodInfo
    ResolveNodeMethod "getDouble" o = NodeGetDoubleMethodInfo
    ResolveNodeMethod "getInt" o = NodeGetIntMethodInfo
    ResolveNodeMethod "getNodeType" o = NodeGetNodeTypeMethodInfo
    ResolveNodeMethod "getObject" o = NodeGetObjectMethodInfo
    ResolveNodeMethod "getParent" o = NodeGetParentMethodInfo
    ResolveNodeMethod "getString" o = NodeGetStringMethodInfo
    ResolveNodeMethod "getValue" o = NodeGetValueMethodInfo
    ResolveNodeMethod "getValueType" o = NodeGetValueTypeMethodInfo
    ResolveNodeMethod "setArray" o = NodeSetArrayMethodInfo
    ResolveNodeMethod "setBoolean" o = NodeSetBooleanMethodInfo
    ResolveNodeMethod "setDouble" o = NodeSetDoubleMethodInfo
    ResolveNodeMethod "setInt" o = NodeSetIntMethodInfo
    ResolveNodeMethod "setObject" o = NodeSetObjectMethodInfo
    ResolveNodeMethod "setParent" o = NodeSetParentMethodInfo
    ResolveNodeMethod "setString" o = NodeSetStringMethodInfo
    ResolveNodeMethod "setValue" o = NodeSetValueMethodInfo
    ResolveNodeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif