{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @JsonArray@ is the representation of the array type inside JSON.
-- 
-- A @JsonArray@ contains [struct/@json@/.Node] elements, which may contain
-- fundamental types, other arrays or objects.
-- 
-- Since arrays can be arbitrarily big, copying them can be expensive; for
-- this reason, they are reference counted. You can control the lifetime of
-- a @JsonArray@ using [method/@json@/.Array.ref] and [method/@json@/.Array.unref].
-- 
-- To append an element, use [method/@json@/.Array.add_element].
-- 
-- To extract an element at a given index, use [method/@json@/.Array.get_element].
-- 
-- To retrieve the entire array in list form, use [method/@json@/.Array.get_elements].
-- 
-- To retrieve the length of the array, use [method/@json@/.Array.get_length].

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

module GI.Json.Structs.Array
    ( 

-- * Exported types
    Array(..)                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addArrayElement]("GI.Json.Structs.Array#g:method:addArrayElement"), [addBooleanElement]("GI.Json.Structs.Array#g:method:addBooleanElement"), [addDoubleElement]("GI.Json.Structs.Array#g:method:addDoubleElement"), [addElement]("GI.Json.Structs.Array#g:method:addElement"), [addIntElement]("GI.Json.Structs.Array#g:method:addIntElement"), [addNullElement]("GI.Json.Structs.Array#g:method:addNullElement"), [addObjectElement]("GI.Json.Structs.Array#g:method:addObjectElement"), [addStringElement]("GI.Json.Structs.Array#g:method:addStringElement"), [dupElement]("GI.Json.Structs.Array#g:method:dupElement"), [equal]("GI.Json.Structs.Array#g:method:equal"), [foreachElement]("GI.Json.Structs.Array#g:method:foreachElement"), [hash]("GI.Json.Structs.Array#g:method:hash"), [isImmutable]("GI.Json.Structs.Array#g:method:isImmutable"), [ref]("GI.Json.Structs.Array#g:method:ref"), [removeElement]("GI.Json.Structs.Array#g:method:removeElement"), [seal]("GI.Json.Structs.Array#g:method:seal"), [unref]("GI.Json.Structs.Array#g:method:unref").
-- 
-- ==== Getters
-- [getArrayElement]("GI.Json.Structs.Array#g:method:getArrayElement"), [getBooleanElement]("GI.Json.Structs.Array#g:method:getBooleanElement"), [getDoubleElement]("GI.Json.Structs.Array#g:method:getDoubleElement"), [getElement]("GI.Json.Structs.Array#g:method:getElement"), [getElements]("GI.Json.Structs.Array#g:method:getElements"), [getIntElement]("GI.Json.Structs.Array#g:method:getIntElement"), [getLength]("GI.Json.Structs.Array#g:method:getLength"), [getNullElement]("GI.Json.Structs.Array#g:method:getNullElement"), [getObjectElement]("GI.Json.Structs.Array#g:method:getObjectElement"), [getStringElement]("GI.Json.Structs.Array#g:method:getStringElement").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveArrayMethod                      ,
#endif

-- ** addArrayElement #method:addArrayElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddArrayElementMethodInfo          ,
#endif
    arrayAddArrayElement                    ,


-- ** addBooleanElement #method:addBooleanElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddBooleanElementMethodInfo        ,
#endif
    arrayAddBooleanElement                  ,


-- ** addDoubleElement #method:addDoubleElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddDoubleElementMethodInfo         ,
#endif
    arrayAddDoubleElement                   ,


-- ** addElement #method:addElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddElementMethodInfo               ,
#endif
    arrayAddElement                         ,


-- ** addIntElement #method:addIntElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddIntElementMethodInfo            ,
#endif
    arrayAddIntElement                      ,


-- ** addNullElement #method:addNullElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddNullElementMethodInfo           ,
#endif
    arrayAddNullElement                     ,


-- ** addObjectElement #method:addObjectElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddObjectElementMethodInfo         ,
#endif
    arrayAddObjectElement                   ,


-- ** addStringElement #method:addStringElement#

#if defined(ENABLE_OVERLOADING)
    ArrayAddStringElementMethodInfo         ,
#endif
    arrayAddStringElement                   ,


-- ** dupElement #method:dupElement#

#if defined(ENABLE_OVERLOADING)
    ArrayDupElementMethodInfo               ,
#endif
    arrayDupElement                         ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    ArrayEqualMethodInfo                    ,
#endif
    arrayEqual                              ,


-- ** foreachElement #method:foreachElement#

#if defined(ENABLE_OVERLOADING)
    ArrayForeachElementMethodInfo           ,
#endif
    arrayForeachElement                     ,


-- ** getArrayElement #method:getArrayElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetArrayElementMethodInfo          ,
#endif
    arrayGetArrayElement                    ,


-- ** getBooleanElement #method:getBooleanElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetBooleanElementMethodInfo        ,
#endif
    arrayGetBooleanElement                  ,


-- ** getDoubleElement #method:getDoubleElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetDoubleElementMethodInfo         ,
#endif
    arrayGetDoubleElement                   ,


-- ** getElement #method:getElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetElementMethodInfo               ,
#endif
    arrayGetElement                         ,


-- ** getElements #method:getElements#

#if defined(ENABLE_OVERLOADING)
    ArrayGetElementsMethodInfo              ,
#endif
    arrayGetElements                        ,


-- ** getIntElement #method:getIntElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetIntElementMethodInfo            ,
#endif
    arrayGetIntElement                      ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    ArrayGetLengthMethodInfo                ,
#endif
    arrayGetLength                          ,


-- ** getNullElement #method:getNullElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetNullElementMethodInfo           ,
#endif
    arrayGetNullElement                     ,


-- ** getObjectElement #method:getObjectElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetObjectElementMethodInfo         ,
#endif
    arrayGetObjectElement                   ,


-- ** getStringElement #method:getStringElement#

#if defined(ENABLE_OVERLOADING)
    ArrayGetStringElementMethodInfo         ,
#endif
    arrayGetStringElement                   ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    ArrayHashMethodInfo                     ,
#endif
    arrayHash                               ,


-- ** isImmutable #method:isImmutable#

#if defined(ENABLE_OVERLOADING)
    ArrayIsImmutableMethodInfo              ,
#endif
    arrayIsImmutable                        ,


-- ** new #method:new#

    arrayNew                                ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ArrayRefMethodInfo                      ,
#endif
    arrayRef                                ,


-- ** removeElement #method:removeElement#

#if defined(ENABLE_OVERLOADING)
    ArrayRemoveElementMethodInfo            ,
#endif
    arrayRemoveElement                      ,


-- ** seal #method:seal#

#if defined(ENABLE_OVERLOADING)
    ArraySealMethodInfo                     ,
#endif
    arraySeal                               ,


-- ** sizedNew #method:sizedNew#

    arraySizedNew                           ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ArrayUnrefMethodInfo                    ,
#endif
    arrayUnref                              ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.Json.Callbacks as Json.Callbacks
import {-# SOURCE #-} qualified GI.Json.Structs.Node as Json.Node
import {-# SOURCE #-} qualified GI.Json.Structs.Object as Json.Object

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

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

foreign import ccall "json_array_get_type" c_json_array_get_type :: 
    IO GType

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

instance B.Types.TypedObject Array where
    glibType :: IO GType
glibType = IO GType
c_json_array_get_type

instance B.Types.GBoxed Array

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


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

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

foreign import ccall "json_array_new" json_array_new :: 
    IO (Ptr Array)

-- | Creates a new array.
arrayNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Array
    -- ^ __Returns:__ the newly created array
arrayNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Array
arrayNew  = IO Array -> m Array
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Array -> m Array) -> IO Array -> m Array
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
result <- IO (Ptr Array)
json_array_new
    Text -> Ptr Array -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayNew" Ptr Array
result
    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
Array) Ptr Array
result
    Array -> IO Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Array::sized_new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "n_elements"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of slots to pre-allocate"
--                 , 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_array_sized_new" json_array_sized_new :: 
    Word32 ->                               -- n_elements : TBasicType TUInt
    IO (Ptr Array)

-- | Creates a new array with @n_elements@ slots already allocated.
arraySizedNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@nElements@/: number of slots to pre-allocate
    -> m Array
    -- ^ __Returns:__ the newly created array
arraySizedNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> m Array
arraySizedNew Word32
nElements = IO Array -> m Array
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Array -> m Array) -> IO Array -> m Array
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
result <- Word32 -> IO (Ptr Array)
json_array_sized_new Word32
nElements
    Text -> Ptr Array -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arraySizedNew" Ptr Array
result
    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
Array) Ptr Array
result
    Array -> IO Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Array::add_array_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the array to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_array_add_array_element" json_array_add_array_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Ptr Array ->                            -- value : TInterface (Name {namespace = "Json", name = "Array"})
    IO ()

-- | Conveniently adds an array element into an array.
-- 
-- If @value@ is @NULL@, a @null@ element will be added instead.
-- 
-- See also: [method/@json@/.Array.add_element], [method/@json@/.Node.take_array]
-- 
-- /Since: 0.8/
arrayAddArrayElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Maybe (Array)
    -- ^ /@value@/: the array to add
    -> m ()
arrayAddArrayElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Maybe Array -> m ()
arrayAddArrayElement Array
array Maybe Array
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Array
maybeValue <- case Maybe Array
value of
        Maybe Array
Nothing -> Ptr Array -> IO (Ptr Array)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Array
forall a. Ptr a
nullPtr
        Just Array
jValue -> do
            Ptr Array
jValue' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Array
jValue
            Ptr Array -> IO (Ptr Array)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Array
jValue'
    Ptr Array -> Ptr Array -> IO ()
json_array_add_array_element Ptr Array
array' Ptr Array
maybeValue
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Maybe Array -> (Array -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Array
value Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayAddArrayElementMethodInfo
instance (signature ~ (Maybe (Array) -> m ()), MonadIO m) => O.OverloadedMethod ArrayAddArrayElementMethodInfo Array signature where
    overloadedMethod = arrayAddArrayElement

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


#endif

-- method Array::add_boolean_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the boolean value to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Conveniently adds the given boolean value into an array.
-- 
-- See also: [method/@json@/.Array.add_element], [method/@json@/.Node.set_boolean]
-- 
-- /Since: 0.8/
arrayAddBooleanElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Bool
    -- ^ /@value@/: the boolean value to add
    -> m ()
arrayAddBooleanElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Bool -> m ()
arrayAddBooleanElement Array
array Bool
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    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 Array -> CInt -> IO ()
json_array_add_boolean_element Ptr Array
array' CInt
value'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayAddBooleanElementMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod ArrayAddBooleanElementMethodInfo Array signature where
    overloadedMethod = arrayAddBooleanElement

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


#endif

-- method Array::add_double_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the floating point value to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Conveniently adds the given floating point value into an array.
-- 
-- See also: [method/@json@/.Array.add_element], [method/@json@/.Node.set_double]
-- 
-- /Since: 0.8/
arrayAddDoubleElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Double
    -- ^ /@value@/: the floating point value to add
    -> m ()
arrayAddDoubleElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Double -> m ()
arrayAddDoubleElement Array
array Double
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Array -> CDouble -> IO ()
json_array_add_double_element Ptr Array
array' CDouble
value'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayAddDoubleElementMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m) => O.OverloadedMethod ArrayAddDoubleElementMethodInfo Array signature where
    overloadedMethod = arrayAddDoubleElement

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


#endif

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

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

-- | Appends the given @node@ inside an array.
arrayAddElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Json.Node.Node
    -- ^ /@node@/: the element to add
    -> m ()
arrayAddElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Node -> m ()
arrayAddElement Array
array Node
node = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Node
node' <- Node -> IO (Ptr Node)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Node
node
    Ptr Array -> Ptr Node -> IO ()
json_array_add_element Ptr Array
array' Ptr Node
node'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Node -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Node
node
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Array::add_int_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the integer value to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Conveniently adds the given integer value into an array.
-- 
-- See also: [method/@json@/.Array.add_element], [method/@json@/.Node.set_int]
-- 
-- /Since: 0.8/
arrayAddIntElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Int64
    -- ^ /@value@/: the integer value to add
    -> m ()
arrayAddIntElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Int64 -> m ()
arrayAddIntElement Array
array Int64
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Array -> Int64 -> IO ()
json_array_add_int_element Ptr Array
array' Int64
value
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayAddIntElementMethodInfo
instance (signature ~ (Int64 -> m ()), MonadIO m) => O.OverloadedMethod ArrayAddIntElementMethodInfo Array signature where
    overloadedMethod = arrayAddIntElement

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


#endif

-- method Array::add_null_element
-- method type : OrdinaryMethod
-- Args: [ 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_array_add_null_element" json_array_add_null_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO ()

-- | Conveniently adds a @null@ element into an array
-- 
-- See also: [method/@json@/.Array.add_element], @JSON_NODE_NULL@
-- 
-- /Since: 0.8/
arrayAddNullElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> m ()
arrayAddNullElement :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Array -> m ()
arrayAddNullElement Array
array = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Array -> IO ()
json_array_add_null_element Ptr Array
array'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayAddNullElementMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ArrayAddNullElementMethodInfo Array signature where
    overloadedMethod = arrayAddNullElement

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


#endif

-- method Array::add_object_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "Object" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the object to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_array_add_object_element" json_array_add_object_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Ptr Json.Object.Object ->               -- value : TInterface (Name {namespace = "Json", name = "Object"})
    IO ()

-- | Conveniently adds an object into an array.
-- 
-- If @value@ is @NULL@, a @null@ element will be added instead.
-- 
-- See also: [method/@json@/.Array.add_element], [method/@json@/.Node.take_object]
-- 
-- /Since: 0.8/
arrayAddObjectElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Maybe (Json.Object.Object)
    -- ^ /@value@/: the object to add
    -> m ()
arrayAddObjectElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Maybe Object -> m ()
arrayAddObjectElement Array
array Maybe Object
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Object
maybeValue <- case Maybe Object
value of
        Maybe Object
Nothing -> Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
forall a. Ptr a
nullPtr
        Just Object
jValue -> do
            Ptr Object
jValue' <- Object -> IO (Ptr Object)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed Object
jValue
            Ptr Object -> IO (Ptr Object)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Object
jValue'
    Ptr Array -> Ptr Object -> IO ()
json_array_add_object_element Ptr Array
array' Ptr Object
maybeValue
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Maybe Object -> (Object -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Object
value Object -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Array::add_string_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string value to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Conveniently adds the given string value into an array.
-- 
-- See also: [method/@json@/.Array.add_element], [method/@json@/.Node.set_string]
-- 
-- /Since: 0.8/
arrayAddStringElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> T.Text
    -- ^ /@value@/: the string value to add
    -> m ()
arrayAddStringElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Text -> m ()
arrayAddStringElement Array
array Text
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr Array -> CString -> IO ()
json_array_add_string_element Ptr Array
array' CString
value'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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


#endif

-- method Array::dup_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_dup_element" json_array_dup_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr Json.Node.Node)

-- | Retrieves a copy of the element at the given position in the array.
-- 
-- /Since: 0.6/
arrayDupElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Json.Node.Node
    -- ^ __Returns:__ a copy of the element at the given position
arrayDupElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Node
arrayDupElement Array
array Word32
index_ = IO Node -> m Node
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> m Node) -> IO Node -> m Node
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Node
result <- Ptr Array -> Word32 -> IO (Ptr Node)
json_array_dup_element Ptr Array
array' Word32
index_
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayDupElement" 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
Json.Node.Node) Ptr Node
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

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

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


#endif

-- method Array::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "a"
--           , 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
--           }
--       , Arg
--           { argCName = "b"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another JSON array" , 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_array_equal" json_array_equal :: 
    Ptr Array ->                            -- a : TInterface (Name {namespace = "Json", name = "Array"})
    Ptr Array ->                            -- b : TInterface (Name {namespace = "Json", name = "Array"})
    IO CInt

-- | Check whether two arrays are equal.
-- 
-- Equality is defined as:
-- 
--  - the array have the same number of elements
--  - the values of elements in corresponding positions are equal
-- 
-- /Since: 1.2/
arrayEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@a@/: a JSON array
    -> Array
    -- ^ /@b@/: another JSON array
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the arrays are equal, and @FALSE@ otherwise
arrayEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Array -> m Bool
arrayEqual Array
a Array
b = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
a' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
a
    Ptr Array
b' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
b
    CInt
result <- Ptr Array -> Ptr Array -> IO CInt
json_array_equal Ptr Array
a' Ptr Array
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
a
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ArrayEqualMethodInfo
instance (signature ~ (Array -> m Bool), MonadIO m) => O.OverloadedMethod ArrayEqualMethodInfo Array signature where
    overloadedMethod = arrayEqual

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


#endif

-- method Array::foreach_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "func"
--           , argType =
--               TInterface Name { namespace = "Json" , name = "ArrayForeach" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function to be called on each element"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to be passed to the function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_array_foreach_element" json_array_foreach_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    FunPtr Json.Callbacks.C_ArrayForeach -> -- func : TInterface (Name {namespace = "Json", name = "ArrayForeach"})
    Ptr () ->                               -- data : TBasicType TPtr
    IO ()

-- | Iterates over all elements of an array, and calls a function on
-- each one of them.
-- 
-- It is safe to change the value of an element of the array while
-- iterating over it, but it is not safe to add or remove elements
-- from the array.
-- 
-- /Since: 0.8/
arrayForeachElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Json.Callbacks.ArrayForeach
    -- ^ /@func@/: the function to be called on each element
    -> m ()
arrayForeachElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> ArrayForeach -> m ()
arrayForeachElement Array
array ArrayForeach
func = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    FunPtr C_ArrayForeach
func' <- C_ArrayForeach -> IO (FunPtr C_ArrayForeach)
Json.Callbacks.mk_ArrayForeach (Maybe (Ptr (FunPtr C_ArrayForeach))
-> ArrayForeach_WithClosures -> C_ArrayForeach
Json.Callbacks.wrap_ArrayForeach Maybe (Ptr (FunPtr C_ArrayForeach))
forall a. Maybe a
Nothing (ArrayForeach -> ArrayForeach_WithClosures
Json.Callbacks.drop_closures_ArrayForeach ArrayForeach
func))
    let data_ :: Ptr a
data_ = Ptr a
forall a. Ptr a
nullPtr
    Ptr Array -> FunPtr C_ArrayForeach -> Ptr () -> IO ()
json_array_foreach_element Ptr Array
array' FunPtr C_ArrayForeach
func' Ptr ()
forall a. Ptr a
data_
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ArrayForeach -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ArrayForeach
func'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayForeachElementMethodInfo
instance (signature ~ (Json.Callbacks.ArrayForeach -> m ()), MonadIO m) => O.OverloadedMethod ArrayForeachElementMethodInfo Array signature where
    overloadedMethod = arrayForeachElement

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


#endif

-- method Array::get_array_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_array_element" json_array_get_array_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr Array)

-- | Conveniently retrieves the array at the given position inside an array.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.get_array]
-- 
-- /Since: 0.8/
arrayGetArrayElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Array
    -- ^ __Returns:__ the array
arrayGetArrayElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Array
arrayGetArrayElement Array
array Word32
index_ = IO Array -> m Array
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Array -> m Array) -> IO Array -> m Array
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Array
result <- Ptr Array -> Word32 -> IO (Ptr Array)
json_array_get_array_element Ptr Array
array' Word32
index_
    Text -> Ptr Array -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayGetArrayElement" Ptr Array
result
    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
Array) Ptr Array
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Array -> IO Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result'

#if defined(ENABLE_OVERLOADING)
data ArrayGetArrayElementMethodInfo
instance (signature ~ (Word32 -> m Array), MonadIO m) => O.OverloadedMethod ArrayGetArrayElementMethodInfo Array signature where
    overloadedMethod = arrayGetArrayElement

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


#endif

-- method Array::get_boolean_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_boolean_element" json_array_get_boolean_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO CInt

-- | Conveniently retrieves the boolean value of the element at the given
-- position inside an array.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.get_boolean]
-- 
-- /Since: 0.8/
arrayGetBooleanElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Bool
    -- ^ __Returns:__ the boolean value
arrayGetBooleanElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Bool
arrayGetBooleanElement Array
array Word32
index_ = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    CInt
result <- Ptr Array -> Word32 -> IO CInt
json_array_get_boolean_element Ptr Array
array' Word32
index_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ArrayGetBooleanElementMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod ArrayGetBooleanElementMethodInfo Array signature where
    overloadedMethod = arrayGetBooleanElement

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


#endif

-- method Array::get_double_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_double_element" json_array_get_double_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO CDouble

-- | Conveniently retrieves the floating point value of the element at
-- the given position inside an array.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.get_double]
-- 
-- /Since: 0.8/
arrayGetDoubleElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Double
    -- ^ __Returns:__ the floating point value
arrayGetDoubleElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Double
arrayGetDoubleElement Array
array Word32
index_ = IO Double -> m Double
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    CDouble
result <- Ptr Array -> Word32 -> IO CDouble
json_array_get_double_element Ptr Array
array' Word32
index_
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ArrayGetDoubleElementMethodInfo
instance (signature ~ (Word32 -> m Double), MonadIO m) => O.OverloadedMethod ArrayGetDoubleElementMethodInfo Array signature where
    overloadedMethod = arrayGetDoubleElement

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


#endif

-- method Array::get_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_element" json_array_get_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr Json.Node.Node)

-- | Retrieves the element at the given position in the array.
arrayGetElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Json.Node.Node
    -- ^ __Returns:__ the element at the given position
arrayGetElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Node
arrayGetElement Array
array Word32
index_ = IO Node -> m Node
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Node -> m Node) -> IO Node -> m Node
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Node
result <- Ptr Array -> Word32 -> IO (Ptr Node)
json_array_get_element Ptr Array
array' Word32
index_
    Text -> Ptr Node -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayGetElement" 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
Json.Node.Node) Ptr Node
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Node -> IO Node
forall (m :: * -> *) a. Monad m => a -> m a
return Node
result'

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

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


#endif

-- method Array::get_elements
-- method type : OrdinaryMethod
-- Args: [ 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: Just
--               (TGList (TInterface Name { namespace = "Json" , name = "Node" }))
-- throws : False
-- Skip return : False

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

-- | Retrieves all the elements of an array as a list of nodes.
arrayGetElements ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> m [Json.Node.Node]
    -- ^ __Returns:__ the elements
    --   of the array
arrayGetElements :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> m [Node]
arrayGetElements Array
array = IO [Node] -> m [Node]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Node] -> m [Node]) -> IO [Node] -> m [Node]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr (GList (Ptr Node))
result <- Ptr Array -> IO (Ptr (GList (Ptr Node)))
json_array_get_elements Ptr Array
array'
    [Ptr Node]
result' <- Ptr (GList (Ptr Node)) -> IO [Ptr Node]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Node))
result
    [Node]
result'' <- (Ptr Node -> IO Node) -> [Ptr Node] -> IO [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Node -> Node) -> Ptr Node -> IO Node
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Node -> Node
Json.Node.Node) [Ptr Node]
result'
    Ptr (GList (Ptr Node)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Node))
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    [Node] -> IO [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
result''

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

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


#endif

-- method Array::get_int_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_int_element" json_array_get_int_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO Int64

-- | Conveniently retrieves the integer value of the element at the given
-- position inside an array.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.get_int]
-- 
-- /Since: 0.8/
arrayGetIntElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Int64
    -- ^ __Returns:__ the integer value
arrayGetIntElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Int64
arrayGetIntElement Array
array Word32
index_ = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Int64
result <- Ptr Array -> Word32 -> IO Int64
json_array_get_int_element Ptr Array
array' Word32
index_
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data ArrayGetIntElementMethodInfo
instance (signature ~ (Word32 -> m Int64), MonadIO m) => O.OverloadedMethod ArrayGetIntElementMethodInfo Array signature where
    overloadedMethod = arrayGetIntElement

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


#endif

-- method Array::get_length
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "json_array_get_length" json_array_get_length :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO Word32

-- | Retrieves the length of the given array
arrayGetLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> m Word32
    -- ^ __Returns:__ the length of the array
arrayGetLength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> m Word32
arrayGetLength Array
array = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Word32
result <- Ptr Array -> IO Word32
json_array_get_length Ptr Array
array'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ArrayGetLengthMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ArrayGetLengthMethodInfo Array signature where
    overloadedMethod = arrayGetLength

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


#endif

-- method Array::get_null_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_null_element" json_array_get_null_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO CInt

-- | Conveniently checks whether the element at the given position inside the
-- array contains a @null@ value.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.is_null]
-- 
-- /Since: 0.8/
arrayGetNullElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the element is @null@
arrayGetNullElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Bool
arrayGetNullElement Array
array Word32
index_ = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    CInt
result <- Ptr Array -> Word32 -> IO CInt
json_array_get_null_element Ptr Array
array' Word32
index_
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ArrayGetNullElementMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m) => O.OverloadedMethod ArrayGetNullElementMethodInfo Array signature where
    overloadedMethod = arrayGetNullElement

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


#endif

-- method Array::get_object_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_object_element" json_array_get_object_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO (Ptr Json.Object.Object)

-- | Conveniently retrieves the object at the given position inside an array.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.get_object]
-- 
-- /Since: 0.8/
arrayGetObjectElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m Json.Object.Object
    -- ^ __Returns:__ the object
arrayGetObjectElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Object
arrayGetObjectElement Array
array Word32
index_ = IO Object -> m Object
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Object
result <- Ptr Array -> Word32 -> IO (Ptr Object)
json_array_get_object_element Ptr Array
array' Word32
index_
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayGetObjectElement" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Object -> Object
Json.Object.Object) Ptr Object
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data ArrayGetObjectElementMethodInfo
instance (signature ~ (Word32 -> m Json.Object.Object), MonadIO m) => O.OverloadedMethod ArrayGetObjectElementMethodInfo Array signature where
    overloadedMethod = arrayGetObjectElement

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


#endif

-- method Array::get_string_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the element to retrieve"
--                 , 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_array_get_string_element" json_array_get_string_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO CString

-- | Conveniently retrieves the string value of the element at the given
-- position inside an array.
-- 
-- See also: [method/@json@/.Array.get_element], [method/@json@/.Node.get_string]
-- 
-- /Since: 0.8/
arrayGetStringElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the index of the element to retrieve
    -> m T.Text
    -- ^ __Returns:__ the string value
arrayGetStringElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m Text
arrayGetStringElement Array
array Word32
index_ = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    CString
result <- Ptr Array -> Word32 -> IO CString
json_array_get_string_element Ptr Array
array' Word32
index_
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayGetStringElement" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ArrayGetStringElementMethodInfo
instance (signature ~ (Word32 -> m T.Text), MonadIO m) => O.OverloadedMethod ArrayGetStringElementMethodInfo Array signature where
    overloadedMethod = arrayGetStringElement

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


#endif

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

-- | Calculates a hash value for the given @key@.
-- 
-- The hash is calculated over the array and all its elements, recursively.
-- 
-- If the array is immutable, this is a fast operation; otherwise, it scales
-- proportionally with the length of the array.
-- 
-- /Since: 1.2/
arrayHash ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@key@/: a JSON array to hash
    -> m Word32
    -- ^ __Returns:__ hash value for the key
arrayHash :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> m Word32
arrayHash Array
key = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
key' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
key
    Word32
result <- Ptr Array -> IO Word32
json_array_hash Ptr Array
key'
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
key
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ArrayHashMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod ArrayHashMethodInfo Array signature where
    overloadedMethod = arrayHash

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


#endif

-- method Array::is_immutable
-- method type : OrdinaryMethod
-- Args: [ 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "json_array_is_immutable" json_array_is_immutable :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO CInt

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

#if defined(ENABLE_OVERLOADING)
data ArrayIsImmutableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod ArrayIsImmutableMethodInfo Array signature where
    overloadedMethod = arrayIsImmutable

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


#endif

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

-- | Acquires a reference on the given array.
arrayRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: the array to reference
    -> m Array
    -- ^ __Returns:__ the passed array, with the reference count
    --   increased by one
arrayRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Array -> m Array
arrayRef Array
array = IO Array -> m Array
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Array -> m Array) -> IO Array -> m Array
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Array
result <- Ptr Array -> IO (Ptr Array)
json_array_ref Ptr Array
array'
    Text -> Ptr Array -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"arrayRef" Ptr Array
result
    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
Array) Ptr Array
result
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    Array -> IO Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
result'

#if defined(ENABLE_OVERLOADING)
data ArrayRefMethodInfo
instance (signature ~ (m Array), MonadIO m) => O.OverloadedMethod ArrayRefMethodInfo Array signature where
    overloadedMethod = arrayRef

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


#endif

-- method Array::remove_element
-- method type : OrdinaryMethod
-- Args: [ 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
--           }
--       , Arg
--           { argCName = "index_"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the element to be removed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "json_array_remove_element" json_array_remove_element :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    Word32 ->                               -- index_ : TBasicType TUInt
    IO ()

-- | Removes the element at the given position inside an array.
-- 
-- This function will release the reference held on the element.
arrayRemoveElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Array
    -- ^ /@array@/: a JSON array
    -> Word32
    -- ^ /@index_@/: the position of the element to be removed
    -> m ()
arrayRemoveElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Array -> Word32 -> m ()
arrayRemoveElement Array
array Word32
index_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Array
array' <- Array -> IO (Ptr Array)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Array
array
    Ptr Array -> Word32 -> IO ()
json_array_remove_element Ptr Array
array' Word32
index_
    Array -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Array
array
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ArrayRemoveElementMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod ArrayRemoveElementMethodInfo Array signature where
    overloadedMethod = arrayRemoveElement

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


#endif

-- method Array::seal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "array"
--           , argType = TInterface Name { namespace = "Json" , name = "Array" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the array 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_array_seal" json_array_seal :: 
    Ptr Array ->                            -- array : TInterface (Name {namespace = "Json", name = "Array"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data ArraySealMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ArraySealMethodInfo Array signature where
    overloadedMethod = arraySeal

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


#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data ArrayUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ArrayUnrefMethodInfo Array signature where
    overloadedMethod = arrayUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveArrayMethod (t :: Symbol) (o :: *) :: * where
    ResolveArrayMethod "addArrayElement" o = ArrayAddArrayElementMethodInfo
    ResolveArrayMethod "addBooleanElement" o = ArrayAddBooleanElementMethodInfo
    ResolveArrayMethod "addDoubleElement" o = ArrayAddDoubleElementMethodInfo
    ResolveArrayMethod "addElement" o = ArrayAddElementMethodInfo
    ResolveArrayMethod "addIntElement" o = ArrayAddIntElementMethodInfo
    ResolveArrayMethod "addNullElement" o = ArrayAddNullElementMethodInfo
    ResolveArrayMethod "addObjectElement" o = ArrayAddObjectElementMethodInfo
    ResolveArrayMethod "addStringElement" o = ArrayAddStringElementMethodInfo
    ResolveArrayMethod "dupElement" o = ArrayDupElementMethodInfo
    ResolveArrayMethod "equal" o = ArrayEqualMethodInfo
    ResolveArrayMethod "foreachElement" o = ArrayForeachElementMethodInfo
    ResolveArrayMethod "hash" o = ArrayHashMethodInfo
    ResolveArrayMethod "isImmutable" o = ArrayIsImmutableMethodInfo
    ResolveArrayMethod "ref" o = ArrayRefMethodInfo
    ResolveArrayMethod "removeElement" o = ArrayRemoveElementMethodInfo
    ResolveArrayMethod "seal" o = ArraySealMethodInfo
    ResolveArrayMethod "unref" o = ArrayUnrefMethodInfo
    ResolveArrayMethod "getArrayElement" o = ArrayGetArrayElementMethodInfo
    ResolveArrayMethod "getBooleanElement" o = ArrayGetBooleanElementMethodInfo
    ResolveArrayMethod "getDoubleElement" o = ArrayGetDoubleElementMethodInfo
    ResolveArrayMethod "getElement" o = ArrayGetElementMethodInfo
    ResolveArrayMethod "getElements" o = ArrayGetElementsMethodInfo
    ResolveArrayMethod "getIntElement" o = ArrayGetIntElementMethodInfo
    ResolveArrayMethod "getLength" o = ArrayGetLengthMethodInfo
    ResolveArrayMethod "getNullElement" o = ArrayGetNullElementMethodInfo
    ResolveArrayMethod "getObjectElement" o = ArrayGetObjectElementMethodInfo
    ResolveArrayMethod "getStringElement" o = ArrayGetStringElementMethodInfo
    ResolveArrayMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif