{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.JavaScriptCore.Objects.Value
    ( 

-- * Exported types
    Value(..)                               ,
    IsValue                                 ,
    toValue                                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [constructorCall]("GI.JavaScriptCore.Objects.Value#g:method:constructorCall"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [functionCall]("GI.JavaScriptCore.Objects.Value#g:method:functionCall"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isArray]("GI.JavaScriptCore.Objects.Value#g:method:isArray"), [isBoolean]("GI.JavaScriptCore.Objects.Value#g:method:isBoolean"), [isConstructor]("GI.JavaScriptCore.Objects.Value#g:method:isConstructor"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFunction]("GI.JavaScriptCore.Objects.Value#g:method:isFunction"), [isNull]("GI.JavaScriptCore.Objects.Value#g:method:isNull"), [isNumber]("GI.JavaScriptCore.Objects.Value#g:method:isNumber"), [isObject]("GI.JavaScriptCore.Objects.Value#g:method:isObject"), [isString]("GI.JavaScriptCore.Objects.Value#g:method:isString"), [isUndefined]("GI.JavaScriptCore.Objects.Value#g:method:isUndefined"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [objectDefinePropertyAccessor]("GI.JavaScriptCore.Objects.Value#g:method:objectDefinePropertyAccessor"), [objectDefinePropertyData]("GI.JavaScriptCore.Objects.Value#g:method:objectDefinePropertyData"), [objectDeleteProperty]("GI.JavaScriptCore.Objects.Value#g:method:objectDeleteProperty"), [objectEnumerateProperties]("GI.JavaScriptCore.Objects.Value#g:method:objectEnumerateProperties"), [objectGetProperty]("GI.JavaScriptCore.Objects.Value#g:method:objectGetProperty"), [objectGetPropertyAtIndex]("GI.JavaScriptCore.Objects.Value#g:method:objectGetPropertyAtIndex"), [objectHasProperty]("GI.JavaScriptCore.Objects.Value#g:method:objectHasProperty"), [objectInvokeMethod]("GI.JavaScriptCore.Objects.Value#g:method:objectInvokeMethod"), [objectIsInstanceOf]("GI.JavaScriptCore.Objects.Value#g:method:objectIsInstanceOf"), [objectSetProperty]("GI.JavaScriptCore.Objects.Value#g:method:objectSetProperty"), [objectSetPropertyAtIndex]("GI.JavaScriptCore.Objects.Value#g:method:objectSetPropertyAtIndex"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toBoolean]("GI.JavaScriptCore.Objects.Value#g:method:toBoolean"), [toDouble]("GI.JavaScriptCore.Objects.Value#g:method:toDouble"), [toInt32]("GI.JavaScriptCore.Objects.Value#g:method:toInt32"), [toJson]("GI.JavaScriptCore.Objects.Value#g:method:toJson"), [toString]("GI.JavaScriptCore.Objects.Value#g:method:toString"), [toStringAsBytes]("GI.JavaScriptCore.Objects.Value#g:method:toStringAsBytes"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getContext]("GI.JavaScriptCore.Objects.Value#g:method:getContext"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveValueMethod                      ,
#endif

-- ** constructorCall #method:constructorCall#

#if defined(ENABLE_OVERLOADING)
    ValueConstructorCallMethodInfo          ,
#endif
    valueConstructorCall                    ,


-- ** functionCall #method:functionCall#

#if defined(ENABLE_OVERLOADING)
    ValueFunctionCallMethodInfo             ,
#endif
    valueFunctionCall                       ,


-- ** getContext #method:getContext#

#if defined(ENABLE_OVERLOADING)
    ValueGetContextMethodInfo               ,
#endif
    valueGetContext                         ,


-- ** isArray #method:isArray#

#if defined(ENABLE_OVERLOADING)
    ValueIsArrayMethodInfo                  ,
#endif
    valueIsArray                            ,


-- ** isBoolean #method:isBoolean#

#if defined(ENABLE_OVERLOADING)
    ValueIsBooleanMethodInfo                ,
#endif
    valueIsBoolean                          ,


-- ** isConstructor #method:isConstructor#

#if defined(ENABLE_OVERLOADING)
    ValueIsConstructorMethodInfo            ,
#endif
    valueIsConstructor                      ,


-- ** isFunction #method:isFunction#

#if defined(ENABLE_OVERLOADING)
    ValueIsFunctionMethodInfo               ,
#endif
    valueIsFunction                         ,


-- ** isNull #method:isNull#

#if defined(ENABLE_OVERLOADING)
    ValueIsNullMethodInfo                   ,
#endif
    valueIsNull                             ,


-- ** isNumber #method:isNumber#

#if defined(ENABLE_OVERLOADING)
    ValueIsNumberMethodInfo                 ,
#endif
    valueIsNumber                           ,


-- ** isObject #method:isObject#

#if defined(ENABLE_OVERLOADING)
    ValueIsObjectMethodInfo                 ,
#endif
    valueIsObject                           ,


-- ** isString #method:isString#

#if defined(ENABLE_OVERLOADING)
    ValueIsStringMethodInfo                 ,
#endif
    valueIsString                           ,


-- ** isUndefined #method:isUndefined#

#if defined(ENABLE_OVERLOADING)
    ValueIsUndefinedMethodInfo              ,
#endif
    valueIsUndefined                        ,


-- ** newArrayFromGarray #method:newArrayFromGarray#

    valueNewArrayFromGarray                 ,


-- ** newArrayFromStrv #method:newArrayFromStrv#

    valueNewArrayFromStrv                   ,


-- ** newBoolean #method:newBoolean#

    valueNewBoolean                         ,


-- ** newFromJson #method:newFromJson#

    valueNewFromJson                        ,


-- ** newFunction #method:newFunction#

    valueNewFunction                        ,


-- ** newFunctionVariadic #method:newFunctionVariadic#

    valueNewFunctionVariadic                ,


-- ** newNull #method:newNull#

    valueNewNull                            ,


-- ** newNumber #method:newNumber#

    valueNewNumber                          ,


-- ** newObject #method:newObject#

    valueNewObject                          ,


-- ** newString #method:newString#

    valueNewString                          ,


-- ** newStringFromBytes #method:newStringFromBytes#

    valueNewStringFromBytes                 ,


-- ** newUndefined #method:newUndefined#

    valueNewUndefined                       ,


-- ** objectDefinePropertyAccessor #method:objectDefinePropertyAccessor#

#if defined(ENABLE_OVERLOADING)
    ValueObjectDefinePropertyAccessorMethodInfo,
#endif
    valueObjectDefinePropertyAccessor       ,


-- ** objectDefinePropertyData #method:objectDefinePropertyData#

#if defined(ENABLE_OVERLOADING)
    ValueObjectDefinePropertyDataMethodInfo ,
#endif
    valueObjectDefinePropertyData           ,


-- ** objectDeleteProperty #method:objectDeleteProperty#

#if defined(ENABLE_OVERLOADING)
    ValueObjectDeletePropertyMethodInfo     ,
#endif
    valueObjectDeleteProperty               ,


-- ** objectEnumerateProperties #method:objectEnumerateProperties#

#if defined(ENABLE_OVERLOADING)
    ValueObjectEnumeratePropertiesMethodInfo,
#endif
    valueObjectEnumerateProperties          ,


-- ** objectGetProperty #method:objectGetProperty#

#if defined(ENABLE_OVERLOADING)
    ValueObjectGetPropertyMethodInfo        ,
#endif
    valueObjectGetProperty                  ,


-- ** objectGetPropertyAtIndex #method:objectGetPropertyAtIndex#

#if defined(ENABLE_OVERLOADING)
    ValueObjectGetPropertyAtIndexMethodInfo ,
#endif
    valueObjectGetPropertyAtIndex           ,


-- ** objectHasProperty #method:objectHasProperty#

#if defined(ENABLE_OVERLOADING)
    ValueObjectHasPropertyMethodInfo        ,
#endif
    valueObjectHasProperty                  ,


-- ** objectInvokeMethod #method:objectInvokeMethod#

#if defined(ENABLE_OVERLOADING)
    ValueObjectInvokeMethodMethodInfo       ,
#endif
    valueObjectInvokeMethod                 ,


-- ** objectIsInstanceOf #method:objectIsInstanceOf#

#if defined(ENABLE_OVERLOADING)
    ValueObjectIsInstanceOfMethodInfo       ,
#endif
    valueObjectIsInstanceOf                 ,


-- ** objectSetProperty #method:objectSetProperty#

#if defined(ENABLE_OVERLOADING)
    ValueObjectSetPropertyMethodInfo        ,
#endif
    valueObjectSetProperty                  ,


-- ** objectSetPropertyAtIndex #method:objectSetPropertyAtIndex#

#if defined(ENABLE_OVERLOADING)
    ValueObjectSetPropertyAtIndexMethodInfo ,
#endif
    valueObjectSetPropertyAtIndex           ,


-- ** toBoolean #method:toBoolean#

#if defined(ENABLE_OVERLOADING)
    ValueToBooleanMethodInfo                ,
#endif
    valueToBoolean                          ,


-- ** toDouble #method:toDouble#

#if defined(ENABLE_OVERLOADING)
    ValueToDoubleMethodInfo                 ,
#endif
    valueToDouble                           ,


-- ** toInt32 #method:toInt32#

#if defined(ENABLE_OVERLOADING)
    ValueToInt32MethodInfo                  ,
#endif
    valueToInt32                            ,


-- ** toJson #method:toJson#

#if defined(ENABLE_OVERLOADING)
    ValueToJsonMethodInfo                   ,
#endif
    valueToJson                             ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    ValueToStringMethodInfo                 ,
#endif
    valueToString                           ,


-- ** toStringAsBytes #method:toStringAsBytes#

#if defined(ENABLE_OVERLOADING)
    ValueToStringAsBytesMethodInfo          ,
#endif
    valueToStringAsBytes                    ,




 -- * Properties


-- ** context #attr:context#
-- | The t'GI.JavaScriptCore.Objects.Context.Context' in which the value was created.

#if defined(ENABLE_OVERLOADING)
    ValueContextPropertyInfo                ,
#endif
    constructValueContext                   ,
    getValueContext                         ,
#if defined(ENABLE_OVERLOADING)
    valueContext                            ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.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.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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.JavaScriptCore.Flags as JavaScriptCore.Flags
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Class as JavaScriptCore.Class
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Context as JavaScriptCore.Context

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

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

foreign import ccall "jsc_value_get_type"
    c_jsc_value_get_type :: IO B.Types.GType

instance B.Types.TypedObject Value where
    glibType :: IO GType
glibType = IO GType
c_jsc_value_get_type

instance B.Types.GObject Value

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveValueMethod (t :: Symbol) (o :: *) :: * where
    ResolveValueMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveValueMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveValueMethod "constructorCall" o = ValueConstructorCallMethodInfo
    ResolveValueMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveValueMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveValueMethod "functionCall" o = ValueFunctionCallMethodInfo
    ResolveValueMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveValueMethod "isArray" o = ValueIsArrayMethodInfo
    ResolveValueMethod "isBoolean" o = ValueIsBooleanMethodInfo
    ResolveValueMethod "isConstructor" o = ValueIsConstructorMethodInfo
    ResolveValueMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveValueMethod "isFunction" o = ValueIsFunctionMethodInfo
    ResolveValueMethod "isNull" o = ValueIsNullMethodInfo
    ResolveValueMethod "isNumber" o = ValueIsNumberMethodInfo
    ResolveValueMethod "isObject" o = ValueIsObjectMethodInfo
    ResolveValueMethod "isString" o = ValueIsStringMethodInfo
    ResolveValueMethod "isUndefined" o = ValueIsUndefinedMethodInfo
    ResolveValueMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveValueMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveValueMethod "objectDefinePropertyAccessor" o = ValueObjectDefinePropertyAccessorMethodInfo
    ResolveValueMethod "objectDefinePropertyData" o = ValueObjectDefinePropertyDataMethodInfo
    ResolveValueMethod "objectDeleteProperty" o = ValueObjectDeletePropertyMethodInfo
    ResolveValueMethod "objectEnumerateProperties" o = ValueObjectEnumeratePropertiesMethodInfo
    ResolveValueMethod "objectGetProperty" o = ValueObjectGetPropertyMethodInfo
    ResolveValueMethod "objectGetPropertyAtIndex" o = ValueObjectGetPropertyAtIndexMethodInfo
    ResolveValueMethod "objectHasProperty" o = ValueObjectHasPropertyMethodInfo
    ResolveValueMethod "objectInvokeMethod" o = ValueObjectInvokeMethodMethodInfo
    ResolveValueMethod "objectIsInstanceOf" o = ValueObjectIsInstanceOfMethodInfo
    ResolveValueMethod "objectSetProperty" o = ValueObjectSetPropertyMethodInfo
    ResolveValueMethod "objectSetPropertyAtIndex" o = ValueObjectSetPropertyAtIndexMethodInfo
    ResolveValueMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveValueMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveValueMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveValueMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveValueMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveValueMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveValueMethod "toBoolean" o = ValueToBooleanMethodInfo
    ResolveValueMethod "toDouble" o = ValueToDoubleMethodInfo
    ResolveValueMethod "toInt32" o = ValueToInt32MethodInfo
    ResolveValueMethod "toJson" o = ValueToJsonMethodInfo
    ResolveValueMethod "toString" o = ValueToStringMethodInfo
    ResolveValueMethod "toStringAsBytes" o = ValueToStringAsBytesMethodInfo
    ResolveValueMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveValueMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveValueMethod "getContext" o = ValueGetContextMethodInfo
    ResolveValueMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveValueMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveValueMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveValueMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveValueMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveValueMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveValueMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "context"
   -- Type: TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@context@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' value #context
-- @
getValueContext :: (MonadIO m, IsValue o) => o -> m JavaScriptCore.Context.Context
getValueContext :: forall (m :: * -> *) o. (MonadIO m, IsValue o) => o -> m Context
getValueContext o
obj = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Context) -> IO Context
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getValueContext" (IO (Maybe Context) -> IO Context)
-> IO (Maybe Context) -> IO Context
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Context -> Context) -> IO (Maybe Context)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"context" ManagedPtr Context -> Context
JavaScriptCore.Context.Context

-- | Construct a `GValueConstruct` with valid value for the “@context@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructValueContext :: (IsValue o, MIO.MonadIO m, JavaScriptCore.Context.IsContext a) => a -> m (GValueConstruct o)
constructValueContext :: forall o (m :: * -> *) a.
(IsValue o, MonadIO m, IsContext a) =>
a -> m (GValueConstruct o)
constructValueContext a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"context" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data ValueContextPropertyInfo
instance AttrInfo ValueContextPropertyInfo where
    type AttrAllowedOps ValueContextPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ValueContextPropertyInfo = IsValue
    type AttrSetTypeConstraint ValueContextPropertyInfo = JavaScriptCore.Context.IsContext
    type AttrTransferTypeConstraint ValueContextPropertyInfo = JavaScriptCore.Context.IsContext
    type AttrTransferType ValueContextPropertyInfo = JavaScriptCore.Context.Context
    type AttrGetType ValueContextPropertyInfo = JavaScriptCore.Context.Context
    type AttrLabel ValueContextPropertyInfo = "context"
    type AttrOrigin ValueContextPropertyInfo = Value
    attrGet = getValueContext
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo JavaScriptCore.Context.Context v
    attrConstruct = constructValueContext
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Value
type instance O.AttributeList Value = ValueAttributeList
type ValueAttributeList = ('[ '("context", ValueContextPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
valueContext :: AttrLabelProxy "context"
valueContext = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Value = ValueSignalList
type ValueSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Value::new_array_from_garray
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "array"
--           , argType =
--               TPtrArray
--                 (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPtrArray" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_array_from_garray" jsc_value_new_array_from_garray :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    Ptr (GPtrArray (Ptr Value)) ->          -- array : TPtrArray (TInterface (Name {namespace = "JavaScriptCore", name = "Value"}))
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' referencing an array with the items from /@array@/. If /@array@/
-- is 'P.Nothing' or empty a new empty array will be created. Elements of /@array@/ should be
-- pointers to a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewArrayFromGarray ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Maybe ([Value])
    -- ^ /@array@/: a t'GI.GLib.Structs.PtrArray.PtrArray'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewArrayFromGarray :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Maybe [Value] -> m Value
valueNewArrayFromGarray a
context Maybe [Value]
array = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr (GPtrArray (Ptr Value))
maybeArray <- case Maybe [Value]
array of
        Maybe [Value]
Nothing -> Ptr (GPtrArray (Ptr Value)) -> IO (Ptr (GPtrArray (Ptr Value)))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GPtrArray (Ptr Value))
forall a. Ptr a
nullPtr
        Just [Value]
jArray -> do
            [Ptr Value]
jArray' <- (Value -> IO (Ptr Value)) -> [Value] -> IO [Ptr Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Value]
jArray
            Ptr (GPtrArray (Ptr Value))
jArray'' <- [Ptr Value] -> IO (Ptr (GPtrArray (Ptr Value)))
forall a. [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray [Ptr Value]
jArray'
            Ptr (GPtrArray (Ptr Value)) -> IO (Ptr (GPtrArray (Ptr Value)))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (GPtrArray (Ptr Value))
jArray''
    Ptr Value
result <- Ptr Context -> Ptr (GPtrArray (Ptr Value)) -> IO (Ptr Value)
jsc_value_new_array_from_garray Ptr Context
context' Ptr (GPtrArray (Ptr Value))
maybeArray
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewArrayFromGarray" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe [Value] -> ([Value] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [Value]
array ((Value -> IO ()) -> [Value] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    Ptr (GPtrArray (Ptr Value)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Value))
maybeArray
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_array_from_strv
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "strv"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a %NULL-terminated array of strings"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_array_from_strv" jsc_value_new_array_from_strv :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    Ptr CString ->                          -- strv : TCArray True (-1) (-1) (TBasicType TUTF8)
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' referencing an array of strings with the items from /@strv@/. If /@array@/
-- is 'P.Nothing' or empty a new empty array will be created.
valueNewArrayFromStrv ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> [T.Text]
    -- ^ /@strv@/: a 'P.Nothing'-terminated array of strings
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewArrayFromStrv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> [Text] -> m Value
valueNewArrayFromStrv a
context [Text]
strv = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr CString
strv' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
strv
    Ptr Value
result <- Ptr Context -> Ptr CString -> IO (Ptr Value)
jsc_value_new_array_from_strv Ptr Context
context' Ptr CString
strv'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewArrayFromStrv" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
strv'
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
strv'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_boolean
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gboolean" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_boolean" jsc_value_new_boolean :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CInt ->                                 -- value : TBasicType TBoolean
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' from /@value@/
valueNewBoolean ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Bool
    -- ^ /@value@/: a t'P.Bool'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewBoolean :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Bool -> m Value
valueNewBoolean a
context Bool
value = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    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 Value
result <- Ptr Context -> CInt -> IO (Ptr Value)
jsc_value_new_boolean Ptr Context
context' CInt
value'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewBoolean" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_from_json
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "json"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the JSON string to be parsed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_from_json" jsc_value_new_from_json :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- json : TBasicType TUTF8
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' referencing a new value created by parsing /@json@/.
-- 
-- /Since: 2.28/
valueNewFromJson ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@json@/: the JSON string to be parsed
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewFromJson :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Text -> m Value
valueNewFromJson a
context Text
json = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
json' <- Text -> IO CString
textToCString Text
json
    Ptr Value
result <- Ptr Context -> CString -> IO (Ptr Value)
jsc_value_new_from_json Ptr Context
context' CString
json'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewFromJson" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
json'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_function_variadic
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function name or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCallback." , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GType of the function return value, or %G_TYPE_NONE if the function is void."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_function_variadic" jsc_value_new_function_variadic :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- name : TBasicType TUTF8
    FunPtr GObject.Callbacks.C_Callback ->  -- callback : TInterface (Name {namespace = "GObject", name = "Callback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    CGType ->                               -- return_type : TBasicType TGType
    IO (Ptr Value)

-- | Create a function in /@context@/. If /@name@/ is 'P.Nothing' an anonymous function will be created.
-- When the function is called by JavaScript or @/jsc_value_function_call()/@, /@callback@/ is called
-- receiving an t'GI.GLib.Structs.PtrArray.PtrArray' of t'GI.JavaScriptCore.Objects.Value.Value's with the arguments and then /@userData@/ as last parameter.
-- When the function is cleared in /@context@/, /@destroyNotify@/ is called with /@userData@/ as parameter.
-- 
-- Note that the value returned by /@callback@/ must be fully transferred. In case of boxed types, you could use
-- @/G_TYPE_POINTER/@ instead of the actual boxed t'GType' to ensure that the instance owned by t'GI.JavaScriptCore.Objects.Class.Class' is used.
-- If you really want to return a new copy of the boxed type, use @/JSC_TYPE_VALUE/@ and return a t'GI.JavaScriptCore.Objects.Value.Value' created
-- with 'GI.JavaScriptCore.Objects.Value.valueNewObject' that receives the copy as instance parameter.
valueNewFunctionVariadic ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Maybe (T.Text)
    -- ^ /@name@/: the function name or 'P.Nothing'
    -> GObject.Callbacks.Callback
    -- ^ /@callback@/: a t'GI.GObject.Callbacks.Callback'.
    -> GType
    -- ^ /@returnType@/: the t'GType' of the function return value, or @/G_TYPE_NONE/@ if the function is void.
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewFunctionVariadic :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Maybe Text -> IO () -> GType -> m Value
valueNewFunctionVariadic a
context Maybe Text
name IO ()
callback GType
returnType = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    FunPtr (IO ())
callback' <- IO () -> IO (FunPtr (IO ()))
GObject.Callbacks.mk_Callback (Maybe (Ptr (FunPtr (IO ()))) -> IO () -> IO ()
GObject.Callbacks.wrap_Callback Maybe (Ptr (FunPtr (IO ())))
forall a. Maybe a
Nothing IO ()
callback)
    let returnType' :: CGType
returnType' = GType -> CGType
gtypeToCGType GType
returnType
    let userData :: Ptr ()
userData = FunPtr (IO ()) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (IO ())
callback'
    let destroyNotify :: FunPtr (Ptr a -> IO ())
destroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Value
result <- Ptr Context
-> CString
-> FunPtr (IO ())
-> Ptr ()
-> FunPtr C_DestroyNotify
-> CGType
-> IO (Ptr Value)
jsc_value_new_function_variadic Ptr Context
context' CString
maybeName FunPtr (IO ())
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyNotify CGType
returnType'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewFunctionVariadic" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_function
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the function name or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCallback." , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 3
--           , argDestroy = 4
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @callback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "return_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #GType of the function return value, or %G_TYPE_NONE if the function is void."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_parameters"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameter_types"
--           , argType = TCArray False (-1) 6 (TBasicType TGType)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a list of #GType<!-- -->s, one for each parameter, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_parameters"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of parameters"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_functionv" jsc_value_new_functionv :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- name : TBasicType TUTF8
    FunPtr GObject.Callbacks.C_Callback ->  -- callback : TInterface (Name {namespace = "GObject", name = "Callback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    CGType ->                               -- return_type : TBasicType TGType
    Word32 ->                               -- n_parameters : TBasicType TUInt
    Ptr CGType ->                           -- parameter_types : TCArray False (-1) 6 (TBasicType TGType)
    IO (Ptr Value)

-- | Create a function in /@context@/. If /@name@/ is 'P.Nothing' an anonymous function will be created.
-- When the function is called by JavaScript or @/jsc_value_function_call()/@, /@callback@/ is called
-- receiving the function parameters and then /@userData@/ as last parameter. When the function is
-- cleared in /@context@/, /@destroyNotify@/ is called with /@userData@/ as parameter.
-- 
-- Note that the value returned by /@callback@/ must be fully transferred. In case of boxed types, you could use
-- @/G_TYPE_POINTER/@ instead of the actual boxed t'GType' to ensure that the instance owned by t'GI.JavaScriptCore.Objects.Class.Class' is used.
-- If you really want to return a new copy of the boxed type, use @/JSC_TYPE_VALUE/@ and return a t'GI.JavaScriptCore.Objects.Value.Value' created
-- with 'GI.JavaScriptCore.Objects.Value.valueNewObject' that receives the copy as instance parameter.
valueNewFunction ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Maybe (T.Text)
    -- ^ /@name@/: the function name or 'P.Nothing'
    -> GObject.Callbacks.Callback
    -- ^ /@callback@/: a t'GI.GObject.Callbacks.Callback'.
    -> GType
    -- ^ /@returnType@/: the t'GType' of the function return value, or @/G_TYPE_NONE/@ if the function is void.
    -> Maybe ([GType])
    -- ^ /@parameterTypes@/: a list of t'GType's, one for each parameter, or 'P.Nothing'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewFunction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Maybe Text -> IO () -> GType -> Maybe [GType] -> m Value
valueNewFunction a
context Maybe Text
name IO ()
callback GType
returnType Maybe [GType]
parameterTypes = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    let nParameters :: Word32
nParameters = case Maybe [GType]
parameterTypes of
            Maybe [GType]
Nothing -> Word32
0
            Just [GType]
jParameterTypes -> Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [GType]
jParameterTypes
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
maybeName <- case Maybe Text
name of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    FunPtr (IO ())
callback' <- IO () -> IO (FunPtr (IO ()))
GObject.Callbacks.mk_Callback (Maybe (Ptr (FunPtr (IO ()))) -> IO () -> IO ()
GObject.Callbacks.wrap_Callback Maybe (Ptr (FunPtr (IO ())))
forall a. Maybe a
Nothing IO ()
callback)
    let returnType' :: CGType
returnType' = GType -> CGType
gtypeToCGType GType
returnType
    Ptr CGType
maybeParameterTypes <- case Maybe [GType]
parameterTypes of
        Maybe [GType]
Nothing -> Ptr CGType -> IO (Ptr CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CGType
forall a. Ptr a
nullPtr
        Just [GType]
jParameterTypes -> do
            Ptr CGType
jParameterTypes' <- ((GType -> CGType) -> [GType] -> IO (Ptr CGType)
forall a b. Storable b => (a -> b) -> [a] -> IO (Ptr b)
packMapStorableArray GType -> CGType
gtypeToCGType) [GType]
jParameterTypes
            Ptr CGType -> IO (Ptr CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CGType
jParameterTypes'
    let userData :: Ptr ()
userData = FunPtr (IO ()) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (IO ())
callback'
    let destroyNotify :: FunPtr (Ptr a -> IO ())
destroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Value
result <- Ptr Context
-> CString
-> FunPtr (IO ())
-> Ptr ()
-> FunPtr C_DestroyNotify
-> CGType
-> Word32
-> Ptr CGType
-> IO (Ptr Value)
jsc_value_new_functionv Ptr Context
context' CString
maybeName FunPtr (IO ())
callback' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyNotify CGType
returnType' Word32
nParameters Ptr CGType
maybeParameterTypes
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewFunction" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
maybeParameterTypes
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_null
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_null" jsc_value_new_null :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' referencing \<function>null\<\/function> in /@context@/.
valueNewNull ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewNull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> m Value
valueNewNull a
context = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Value
result <- Ptr Context -> IO (Ptr Value)
jsc_value_new_null Ptr Context
context'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewNull" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_number
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "number"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a number" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_number" jsc_value_new_number :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CDouble ->                              -- number : TBasicType TDouble
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' from /@number@/.
valueNewNumber ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Double
    -- ^ /@number@/: a number
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Double -> m Value
valueNewNumber a
context Double
number = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let number' :: CDouble
number' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
number
    Ptr Value
result <- Ptr Context -> CDouble -> IO (Ptr Value)
jsc_value_new_number Ptr Context
context' CDouble
number'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewNumber" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_object
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "instance"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an object instance or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "jsc_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #JSCClass of @instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_object" jsc_value_new_object :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    Ptr () ->                               -- instance : TBasicType TPtr
    Ptr JavaScriptCore.Class.Class ->       -- jsc_class : TInterface (Name {namespace = "JavaScriptCore", name = "Class"})
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' from /@instance@/. If /@instance@/ is 'P.Nothing' a new empty object is created.
-- When /@instance@/ is provided, /@jscClass@/ must be provided too. /@jscClass@/ takes ownership of
-- /@instance@/ that will be freed by the t'GI.GLib.Callbacks.DestroyNotify' passed to 'GI.JavaScriptCore.Objects.Context.contextRegisterClass'.
valueNewObject ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a, JavaScriptCore.Class.IsClass b) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: an object instance or 'P.Nothing'
    -> Maybe (b)
    -- ^ /@jscClass@/: the t'GI.JavaScriptCore.Objects.Class.Class' of /@instance@/
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewObject :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContext a, IsClass b) =>
a -> Ptr () -> Maybe b -> m Value
valueNewObject a
context Ptr ()
instance_ Maybe b
jscClass = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Class
maybeJscClass <- case Maybe b
jscClass of
        Maybe b
Nothing -> Ptr Class -> IO (Ptr Class)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Class
forall a. Ptr a
nullPtr
        Just b
jJscClass -> do
            Ptr Class
jJscClass' <- b -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jJscClass
            Ptr Class -> IO (Ptr Class)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Class
jJscClass'
    Ptr Value
result <- Ptr Context -> Ptr () -> Ptr Class -> IO (Ptr Value)
jsc_value_new_object Ptr Context
context' Ptr ()
instance_ Ptr Class
maybeJscClass
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewObject" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
jscClass b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_string
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a null-terminated string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_string" jsc_value_new_string :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' from /@string@/. If you need to create a t'GI.JavaScriptCore.Objects.Value.Value' from a
-- string containing null characters, use 'GI.JavaScriptCore.Objects.Value.valueNewStringFromBytes' instead.
valueNewString ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Maybe (T.Text)
    -- ^ /@string@/: a null-terminated string
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Maybe Text -> m Value
valueNewString a
context Maybe Text
string = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
maybeString <- case Maybe Text
string of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jString -> do
            CString
jString' <- Text -> IO CString
textToCString Text
jString
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jString'
    Ptr Value
result <- Ptr Context -> CString -> IO (Ptr Value)
jsc_value_new_string Ptr Context
context' CString
maybeString
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewString" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeString
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_string_from_bytes
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_string_from_bytes" jsc_value_new_string_from_bytes :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    Ptr GLib.Bytes.Bytes ->                 -- bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' from /@bytes@/.
valueNewStringFromBytes ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Maybe (GLib.Bytes.Bytes)
    -- ^ /@bytes@/: a t'GI.GLib.Structs.Bytes.Bytes'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewStringFromBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> Maybe Bytes -> m Value
valueNewStringFromBytes a
context Maybe Bytes
bytes = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Bytes
maybeBytes <- case Maybe Bytes
bytes of
        Maybe Bytes
Nothing -> Ptr Bytes -> IO (Ptr Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bytes
forall a. Ptr a
nullPtr
        Just Bytes
jBytes -> do
            Ptr Bytes
jBytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
jBytes
            Ptr Bytes -> IO (Ptr Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Bytes
jBytes'
    Ptr Value
result <- Ptr Context -> Ptr Bytes -> IO (Ptr Value)
jsc_value_new_string_from_bytes Ptr Context
context' Ptr Bytes
maybeBytes
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewStringFromBytes" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe Bytes -> (Bytes -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Bytes
bytes Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_undefined
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_new_undefined" jsc_value_new_undefined :: 
    Ptr JavaScriptCore.Context.Context ->   -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    IO (Ptr Value)

-- | Create a new t'GI.JavaScriptCore.Objects.Value.Value' referencing \<function>undefined\<\/function> in /@context@/.
valueNewUndefined ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'.
valueNewUndefined :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContext a) =>
a -> m Value
valueNewUndefined a
context = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Value
result <- Ptr Context -> IO (Ptr Value)
jsc_value_new_undefined Ptr Context
context'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueNewUndefined" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::constructor_call
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_parameters"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameters"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #JSCValue<!-- -->s to pass as parameters to the constructor, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_parameters"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of parameters"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_constructor_callv" jsc_value_constructor_callv :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    Word32 ->                               -- n_parameters : TBasicType TUInt
    Ptr (Ptr Value) ->                      -- parameters : TCArray False (-1) 1 (TInterface (Name {namespace = "JavaScriptCore", name = "Value"}))
    IO (Ptr Value)

-- | Invoke \<function>new\<\/function> with constructor referenced by /@value@/. If /@nParameters@/
-- is 0 no parameters will be passed to the constructor.
valueConstructorCall ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> Maybe ([Value])
    -- ^ /@parameters@/: the t'GI.JavaScriptCore.Objects.Value.Value's to pass as parameters to the constructor, or 'P.Nothing'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' referencing the newly created object instance.
valueConstructorCall :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Maybe [Value] -> m Value
valueConstructorCall a
value Maybe [Value]
parameters = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    let nParameters :: Word32
nParameters = case Maybe [Value]
parameters of
            Maybe [Value]
Nothing -> Word32
0
            Just [Value]
jParameters -> Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Value]
jParameters
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr (Ptr Value)
maybeParameters <- case Maybe [Value]
parameters of
        Maybe [Value]
Nothing -> Ptr (Ptr Value) -> IO (Ptr (Ptr Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr Value)
forall a. Ptr a
nullPtr
        Just [Value]
jParameters -> do
            [Ptr Value]
jParameters' <- (Value -> IO (Ptr Value)) -> [Value] -> IO [Ptr Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Value]
jParameters
            Ptr (Ptr Value)
jParameters'' <- [Ptr Value] -> IO (Ptr (Ptr Value))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Value]
jParameters'
            Ptr (Ptr Value) -> IO (Ptr (Ptr Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr Value)
jParameters''
    Ptr Value
result <- Ptr Value -> Word32 -> Ptr (Ptr Value) -> IO (Ptr Value)
jsc_value_constructor_callv Ptr Value
value' Word32
nParameters Ptr (Ptr Value)
maybeParameters
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueConstructorCall" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Maybe [Value] -> ([Value] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [Value]
parameters ((Value -> IO ()) -> [Value] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    Ptr (Ptr Value) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Value)
maybeParameters
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ValueConstructorCallMethodInfo
instance (signature ~ (Maybe ([Value]) -> m Value), MonadIO m, IsValue a) => O.OverloadedMethod ValueConstructorCallMethodInfo a signature where
    overloadedMethod = valueConstructorCall

instance O.OverloadedMethodInfo ValueConstructorCallMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueConstructorCall",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueConstructorCall"
        }


#endif

-- method Value::function_call
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_parameters"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameters"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 1
--                 (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #JSCValue<!-- -->s to pass as parameters to the function, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_parameters"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of parameters"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_function_callv" jsc_value_function_callv :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    Word32 ->                               -- n_parameters : TBasicType TUInt
    Ptr (Ptr Value) ->                      -- parameters : TCArray False (-1) 1 (TInterface (Name {namespace = "JavaScriptCore", name = "Value"}))
    IO (Ptr Value)

-- | Call function referenced by /@value@/, passing the given /@parameters@/. If /@nParameters@/
-- is 0 no parameters will be passed to the function.
-- 
-- This function always returns a t'GI.JavaScriptCore.Objects.Value.Value', in case of void functions a t'GI.JavaScriptCore.Objects.Value.Value' referencing
-- \<function>undefined\<\/function> is returned
valueFunctionCall ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> Maybe ([Value])
    -- ^ /@parameters@/: the t'GI.JavaScriptCore.Objects.Value.Value's to pass as parameters to the function, or 'P.Nothing'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' with the return value of the function.
valueFunctionCall :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Maybe [Value] -> m Value
valueFunctionCall a
value Maybe [Value]
parameters = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    let nParameters :: Word32
nParameters = case Maybe [Value]
parameters of
            Maybe [Value]
Nothing -> Word32
0
            Just [Value]
jParameters -> Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Value]
jParameters
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr (Ptr Value)
maybeParameters <- case Maybe [Value]
parameters of
        Maybe [Value]
Nothing -> Ptr (Ptr Value) -> IO (Ptr (Ptr Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr Value)
forall a. Ptr a
nullPtr
        Just [Value]
jParameters -> do
            [Ptr Value]
jParameters' <- (Value -> IO (Ptr Value)) -> [Value] -> IO [Ptr Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Value]
jParameters
            Ptr (Ptr Value)
jParameters'' <- [Ptr Value] -> IO (Ptr (Ptr Value))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Value]
jParameters'
            Ptr (Ptr Value) -> IO (Ptr (Ptr Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr Value)
jParameters''
    Ptr Value
result <- Ptr Value -> Word32 -> Ptr (Ptr Value) -> IO (Ptr Value)
jsc_value_function_callv Ptr Value
value' Word32
nParameters Ptr (Ptr Value)
maybeParameters
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueFunctionCall" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Maybe [Value] -> ([Value] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [Value]
parameters ((Value -> IO ()) -> [Value] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    Ptr (Ptr Value) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Value)
maybeParameters
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ValueFunctionCallMethodInfo
instance (signature ~ (Maybe ([Value]) -> m Value), MonadIO m, IsValue a) => O.OverloadedMethod ValueFunctionCallMethodInfo a signature where
    overloadedMethod = valueFunctionCall

instance O.OverloadedMethodInfo ValueFunctionCallMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueFunctionCall",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueFunctionCall"
        }


#endif

-- method Value::get_context
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "JavaScriptCore" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_get_context" jsc_value_get_context :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO (Ptr JavaScriptCore.Context.Context)

-- | Get the t'GI.JavaScriptCore.Objects.Context.Context' in which /@value@/ was created.
valueGetContext ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m JavaScriptCore.Context.Context
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.Value.Value' context.
valueGetContext :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Context
valueGetContext a
value = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr Context
result <- Ptr Value -> IO (Ptr Context)
jsc_value_get_context Ptr Value
value'
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueGetContext" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Context -> Context
JavaScriptCore.Context.Context) Ptr Context
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
data ValueGetContextMethodInfo
instance (signature ~ (m JavaScriptCore.Context.Context), MonadIO m, IsValue a) => O.OverloadedMethod ValueGetContextMethodInfo a signature where
    overloadedMethod = valueGetContext

instance O.OverloadedMethodInfo ValueGetContextMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueGetContext",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueGetContext"
        }


#endif

-- method Value::is_array
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_array" jsc_value_is_array :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is an array.
valueIsArray ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is an array.
valueIsArray :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsArray a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_array Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsArrayMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsArrayMethodInfo a signature where
    overloadedMethod = valueIsArray

instance O.OverloadedMethodInfo ValueIsArrayMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsArray",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsArray"
        }


#endif

-- method Value::is_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_boolean" jsc_value_is_boolean :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is a boolean.
valueIsBoolean ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is a boolean.
valueIsBoolean :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsBoolean a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_boolean Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsBooleanMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsBooleanMethodInfo a signature where
    overloadedMethod = valueIsBoolean

instance O.OverloadedMethodInfo ValueIsBooleanMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsBoolean",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsBoolean"
        }


#endif

-- method Value::is_constructor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_constructor" jsc_value_is_constructor :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is a constructor.
valueIsConstructor ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is a constructor.
valueIsConstructor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsConstructor a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_constructor Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsConstructorMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsConstructorMethodInfo a signature where
    overloadedMethod = valueIsConstructor

instance O.OverloadedMethodInfo ValueIsConstructorMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsConstructor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsConstructor"
        }


#endif

-- method Value::is_function
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_function" jsc_value_is_function :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is a function
valueIsFunction ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is a function.
valueIsFunction :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsFunction a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_function Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsFunctionMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsFunctionMethodInfo a signature where
    overloadedMethod = valueIsFunction

instance O.OverloadedMethodInfo ValueIsFunctionMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsFunction",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsFunction"
        }


#endif

-- method Value::is_null
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_null" jsc_value_is_null :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is \<function>null\<\/function>.
valueIsNull ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is null.
valueIsNull :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsNull a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_null Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsNullMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsNullMethodInfo a signature where
    overloadedMethod = valueIsNull

instance O.OverloadedMethodInfo ValueIsNullMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsNull",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsNull"
        }


#endif

-- method Value::is_number
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_number" jsc_value_is_number :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is a number.
valueIsNumber ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is a number.
valueIsNumber :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsNumber a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_number Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsNumberMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsNumberMethodInfo a signature where
    overloadedMethod = valueIsNumber

instance O.OverloadedMethodInfo ValueIsNumberMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsNumber",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsNumber"
        }


#endif

-- method Value::is_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_object" jsc_value_is_object :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is an object.
valueIsObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is an object.
valueIsObject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsObject a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_object Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsObjectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsObjectMethodInfo a signature where
    overloadedMethod = valueIsObject

instance O.OverloadedMethodInfo ValueIsObjectMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsObject",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsObject"
        }


#endif

-- method Value::is_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_string" jsc_value_is_string :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is a string
valueIsString ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is a string
valueIsString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsString a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_string Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsStringMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsStringMethodInfo a signature where
    overloadedMethod = valueIsString

instance O.OverloadedMethodInfo ValueIsStringMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsString"
        }


#endif

-- method Value::is_undefined
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_is_undefined" jsc_value_is_undefined :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Get whether the value referenced by /@value@/ is \<function>undefined\<\/function>.
valueIsUndefined ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ whether the value is undefined.
valueIsUndefined :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueIsUndefined a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_is_undefined Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueIsUndefinedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueIsUndefinedMethodInfo a signature where
    overloadedMethod = valueIsUndefined

instance O.OverloadedMethodInfo ValueIsUndefinedMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueIsUndefined",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueIsUndefined"
        }


#endif

-- method Value::object_define_property_accessor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to define"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "ValuePropertyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#JSCValuePropertyFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType of the property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "getter"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GCallback to be called to get the property value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "setter"
--           , argType =
--               TInterface Name { namespace = "GObject" , name = "Callback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GCallback to be called to set the property value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 6
--           , argDestroy = 7
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @getter and @setter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_define_property_accessor" jsc_value_object_define_property_accessor :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- property_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "JavaScriptCore", name = "ValuePropertyFlags"})
    CGType ->                               -- property_type : TBasicType TGType
    FunPtr GObject.Callbacks.C_Callback ->  -- getter : TInterface (Name {namespace = "GObject", name = "Callback"})
    FunPtr GObject.Callbacks.C_Callback ->  -- setter : TInterface (Name {namespace = "GObject", name = "Callback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Define or modify a property with /@propertyName@/ in object referenced by /@value@/. When the
-- property value needs to be getted or set, /@getter@/ and /@setter@/ callbacks will be called.
-- When the property is cleared in the t'GI.JavaScriptCore.Objects.Class.Class' context, /@destroyNotify@/ is called with
-- /@userData@/ as parameter. This is equivalent to JavaScript \<function>Object.@/defineProperty()/@\<\/function>
-- when used with an accessor descriptor.
-- 
-- Note that the value returned by /@getter@/ must be fully transferred. In case of boxed types, you could use
-- @/G_TYPE_POINTER/@ instead of the actual boxed t'GType' to ensure that the instance owned by t'GI.JavaScriptCore.Objects.Class.Class' is used.
-- If you really want to return a new copy of the boxed type, use @/JSC_TYPE_VALUE/@ and return a t'GI.JavaScriptCore.Objects.Value.Value' created
-- with 'GI.JavaScriptCore.Objects.Value.valueNewObject' that receives the copy as instance parameter.
valueObjectDefinePropertyAccessor ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to define
    -> [JavaScriptCore.Flags.ValuePropertyFlags]
    -- ^ /@flags@/: t'GI.JavaScriptCore.Flags.ValuePropertyFlags'
    -> GType
    -- ^ /@propertyType@/: the t'GType' of the property
    -> Maybe (GObject.Callbacks.Callback)
    -- ^ /@getter@/: a t'GI.GObject.Callbacks.Callback' to be called to get the property value
    -> Maybe (GObject.Callbacks.Callback)
    -- ^ /@setter@/: a t'GI.GObject.Callbacks.Callback' to be called to set the property value
    -> m ()
valueObjectDefinePropertyAccessor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a
-> Text
-> [ValuePropertyFlags]
-> GType
-> Maybe (IO ())
-> Maybe (IO ())
-> m ()
valueObjectDefinePropertyAccessor a
value Text
propertyName [ValuePropertyFlags]
flags GType
propertyType Maybe (IO ())
getter Maybe (IO ())
setter = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let flags' :: CUInt
flags' = [ValuePropertyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ValuePropertyFlags]
flags
    let propertyType' :: CGType
propertyType' = GType -> CGType
gtypeToCGType GType
propertyType
    FunPtr (IO ())
maybeGetter <- case Maybe (IO ())
getter of
        Maybe (IO ())
Nothing -> FunPtr (IO ()) -> IO (FunPtr (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr (IO ())
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just IO ()
jGetter -> do
            Ptr (FunPtr (IO ()))
ptrgetter <- IO (Ptr (FunPtr (IO ())))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GObject.Callbacks.C_Callback))
            FunPtr (IO ())
jGetter' <- IO () -> IO (FunPtr (IO ()))
GObject.Callbacks.mk_Callback (Maybe (Ptr (FunPtr (IO ()))) -> IO () -> IO ()
GObject.Callbacks.wrap_Callback (Ptr (FunPtr (IO ())) -> Maybe (Ptr (FunPtr (IO ())))
forall a. a -> Maybe a
Just Ptr (FunPtr (IO ()))
ptrgetter) IO ()
jGetter)
            Ptr (FunPtr (IO ())) -> FunPtr (IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr (IO ()))
ptrgetter FunPtr (IO ())
jGetter'
            FunPtr (IO ()) -> IO (FunPtr (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr (IO ())
jGetter'
    FunPtr (IO ())
maybeSetter <- case Maybe (IO ())
setter of
        Maybe (IO ())
Nothing -> FunPtr (IO ()) -> IO (FunPtr (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr (IO ())
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just IO ()
jSetter -> do
            FunPtr (IO ())
jSetter' <- IO () -> IO (FunPtr (IO ()))
GObject.Callbacks.mk_Callback (Maybe (Ptr (FunPtr (IO ()))) -> IO () -> IO ()
GObject.Callbacks.wrap_Callback Maybe (Ptr (FunPtr (IO ())))
forall a. Maybe a
Nothing IO ()
jSetter)
            FunPtr (IO ()) -> IO (FunPtr (IO ()))
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr (IO ())
jSetter'
    let userData :: Ptr ()
userData = FunPtr (IO ()) -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr (IO ())
maybeSetter
    let destroyNotify :: FunPtr (Ptr a -> IO ())
destroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr Value
-> CString
-> CUInt
-> CGType
-> FunPtr (IO ())
-> FunPtr (IO ())
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
jsc_value_object_define_property_accessor Ptr Value
value' CString
propertyName' CUInt
flags' CGType
propertyType' FunPtr (IO ())
maybeGetter FunPtr (IO ())
maybeSetter Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyNotify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ValueObjectDefinePropertyAccessorMethodInfo
instance (signature ~ (T.Text -> [JavaScriptCore.Flags.ValuePropertyFlags] -> GType -> Maybe (GObject.Callbacks.Callback) -> Maybe (GObject.Callbacks.Callback) -> m ()), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectDefinePropertyAccessorMethodInfo a signature where
    overloadedMethod = valueObjectDefinePropertyAccessor

instance O.OverloadedMethodInfo ValueObjectDefinePropertyAccessorMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectDefinePropertyAccessor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectDefinePropertyAccessor"
        }


#endif

-- method Value::object_define_property_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the property to define"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "ValuePropertyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#JSCValuePropertyFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property_value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the default property value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_define_property_data" jsc_value_object_define_property_data :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- property_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "JavaScriptCore", name = "ValuePropertyFlags"})
    Ptr Value ->                            -- property_value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO ()

-- | Define or modify a property with /@propertyName@/ in object referenced by /@value@/. This is equivalent to
-- JavaScript \<function>Object.@/defineProperty()/@\<\/function> when used with a data descriptor.
valueObjectDefinePropertyData ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a, IsValue b) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@propertyName@/: the name of the property to define
    -> [JavaScriptCore.Flags.ValuePropertyFlags]
    -- ^ /@flags@/: t'GI.JavaScriptCore.Flags.ValuePropertyFlags'
    -> Maybe (b)
    -- ^ /@propertyValue@/: the default property value
    -> m ()
valueObjectDefinePropertyData :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsValue a, IsValue b) =>
a -> Text -> [ValuePropertyFlags] -> Maybe b -> m ()
valueObjectDefinePropertyData a
value Text
propertyName [ValuePropertyFlags]
flags Maybe b
propertyValue = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
propertyName' <- Text -> IO CString
textToCString Text
propertyName
    let flags' :: CUInt
flags' = [ValuePropertyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ValuePropertyFlags]
flags
    Ptr Value
maybePropertyValue <- case Maybe b
propertyValue of
        Maybe b
Nothing -> Ptr Value -> IO (Ptr Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Value
forall a. Ptr a
nullPtr
        Just b
jPropertyValue -> do
            Ptr Value
jPropertyValue' <- b -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jPropertyValue
            Ptr Value -> IO (Ptr Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Value
jPropertyValue'
    Ptr Value -> CString -> CUInt -> Ptr Value -> IO ()
jsc_value_object_define_property_data Ptr Value
value' CString
propertyName' CUInt
flags' Ptr Value
maybePropertyValue
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
propertyValue b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
propertyName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ValueObjectDefinePropertyDataMethodInfo
instance (signature ~ (T.Text -> [JavaScriptCore.Flags.ValuePropertyFlags] -> Maybe (b) -> m ()), MonadIO m, IsValue a, IsValue b) => O.OverloadedMethod ValueObjectDefinePropertyDataMethodInfo a signature where
    overloadedMethod = valueObjectDefinePropertyData

instance O.OverloadedMethodInfo ValueObjectDefinePropertyDataMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectDefinePropertyData",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectDefinePropertyData"
        }


#endif

-- method Value::object_delete_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property name" , 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 "jsc_value_object_delete_property" jsc_value_object_delete_property :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Try to delete property with /@name@/ from /@value@/. This function will return 'P.False' if
-- the property was defined without 'GI.JavaScriptCore.Flags.ValuePropertyFlagsConfigurable' flag.
valueObjectDeleteProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@name@/: the property name
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the property was deleted, or 'P.False' otherwise.
valueObjectDeleteProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Text -> m Bool
valueObjectDeleteProperty a
value Text
name = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Value -> CString -> IO CInt
jsc_value_object_delete_property Ptr Value
value' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueObjectDeletePropertyMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectDeletePropertyMethodInfo a signature where
    overloadedMethod = valueObjectDeleteProperty

instance O.OverloadedMethodInfo ValueObjectDeletePropertyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectDeleteProperty",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectDeleteProperty"
        }


#endif

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

foreign import ccall "jsc_value_object_enumerate_properties" jsc_value_object_enumerate_properties :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO (Ptr CString)

-- | Get the list of property names of /@value@/. Only properties defined with 'GI.JavaScriptCore.Flags.ValuePropertyFlagsEnumerable'
-- flag will be collected.
valueObjectEnumerateProperties ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of strings containing the
    --    property names, or 'P.Nothing' if /@value@/ doesn\'t have enumerable properties.  Use 'GI.GLib.Functions.strfreev' to free.
valueObjectEnumerateProperties :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m (Maybe [Text])
valueObjectEnumerateProperties a
value = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr CString
result <- Ptr Value -> IO (Ptr CString)
jsc_value_object_enumerate_properties Ptr Value
value'
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

#if defined(ENABLE_OVERLOADING)
data ValueObjectEnumeratePropertiesMethodInfo
instance (signature ~ (m (Maybe [T.Text])), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectEnumeratePropertiesMethodInfo a signature where
    overloadedMethod = valueObjectEnumerateProperties

instance O.OverloadedMethodInfo ValueObjectEnumeratePropertiesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectEnumerateProperties",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectEnumerateProperties"
        }


#endif

-- method Value::object_get_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_get_property" jsc_value_object_get_property :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr Value)

-- | Get property with /@name@/ from /@value@/.
valueObjectGetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@name@/: the property name
    -> m Value
    -- ^ __Returns:__ the property t'GI.JavaScriptCore.Objects.Value.Value'.
valueObjectGetProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Text -> m Value
valueObjectGetProperty a
value Text
name = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Value
result <- Ptr Value -> CString -> IO (Ptr Value)
jsc_value_object_get_property Ptr Value
value' CString
name'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueObjectGetProperty" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ValueObjectGetPropertyMethodInfo
instance (signature ~ (T.Text -> m Value), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectGetPropertyMethodInfo a signature where
    overloadedMethod = valueObjectGetProperty

instance O.OverloadedMethodInfo ValueObjectGetPropertyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectGetProperty",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectGetProperty"
        }


#endif

-- method Value::object_get_property_at_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 property index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_get_property_at_index" jsc_value_object_get_property_at_index :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    Word32 ->                               -- index : TBasicType TUInt
    IO (Ptr Value)

-- | Get property at /@index@/ from /@value@/.
valueObjectGetPropertyAtIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> Word32
    -- ^ /@index@/: the property index
    -> m Value
    -- ^ __Returns:__ the property t'GI.JavaScriptCore.Objects.Value.Value'.
valueObjectGetPropertyAtIndex :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Word32 -> m Value
valueObjectGetPropertyAtIndex a
value Word32
index = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr Value
result <- Ptr Value -> Word32 -> IO (Ptr Value)
jsc_value_object_get_property_at_index Ptr Value
value' Word32
index
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueObjectGetPropertyAtIndex" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ValueObjectGetPropertyAtIndexMethodInfo
instance (signature ~ (Word32 -> m Value), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectGetPropertyAtIndexMethodInfo a signature where
    overloadedMethod = valueObjectGetPropertyAtIndex

instance O.OverloadedMethodInfo ValueObjectGetPropertyAtIndexMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectGetPropertyAtIndex",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectGetPropertyAtIndex"
        }


#endif

-- method Value::object_has_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property name" , 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 "jsc_value_object_has_property" jsc_value_object_has_property :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Get whether /@value@/ has property with /@name@/.
valueObjectHasProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@name@/: the property name
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@value@/ has a property with /@name@/, or 'P.False' otherwise
valueObjectHasProperty :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Text -> m Bool
valueObjectHasProperty a
value Text
name = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Value -> CString -> IO CInt
jsc_value_object_has_property Ptr Value
value' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueObjectHasPropertyMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectHasPropertyMethodInfo a signature where
    overloadedMethod = valueObjectHasProperty

instance O.OverloadedMethodInfo ValueObjectHasPropertyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectHasProperty",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectHasProperty"
        }


#endif

-- method Value::object_invoke_method
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the method name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_parameters"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of parameters"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parameters"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 2
--                 (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the #JSCValue<!-- -->s to pass as parameters to the method, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_parameters"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the number of parameters"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_invoke_methodv" jsc_value_object_invoke_methodv :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- name : TBasicType TUTF8
    Word32 ->                               -- n_parameters : TBasicType TUInt
    Ptr (Ptr Value) ->                      -- parameters : TCArray False (-1) 2 (TInterface (Name {namespace = "JavaScriptCore", name = "Value"}))
    IO (Ptr Value)

-- | Invoke method with /@name@/ on object referenced by /@value@/, passing the given /@parameters@/. If
-- /@nParameters@/ is 0 no parameters will be passed to the method.
-- The object instance will be handled automatically even when the method is a custom one
-- registered with @/jsc_class_add_method()/@, so it should never be passed explicitly as parameter
-- of this function.
-- 
-- This function always returns a t'GI.JavaScriptCore.Objects.Value.Value', in case of void methods a t'GI.JavaScriptCore.Objects.Value.Value' referencing
-- \<function>undefined\<\/function> is returned.
valueObjectInvokeMethod ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@name@/: the method name
    -> Maybe ([Value])
    -- ^ /@parameters@/: the t'GI.JavaScriptCore.Objects.Value.Value's to pass as parameters to the method, or 'P.Nothing'
    -> m Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' with the return value of the method.
valueObjectInvokeMethod :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Text -> Maybe [Value] -> m Value
valueObjectInvokeMethod a
value Text
name Maybe [Value]
parameters = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    let nParameters :: Word32
nParameters = case Maybe [Value]
parameters of
            Maybe [Value]
Nothing -> Word32
0
            Just [Value]
jParameters -> Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Value]
jParameters
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr Value)
maybeParameters <- case Maybe [Value]
parameters of
        Maybe [Value]
Nothing -> Ptr (Ptr Value) -> IO (Ptr (Ptr Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr Value)
forall a. Ptr a
nullPtr
        Just [Value]
jParameters -> do
            [Ptr Value]
jParameters' <- (Value -> IO (Ptr Value)) -> [Value] -> IO [Ptr Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Value]
jParameters
            Ptr (Ptr Value)
jParameters'' <- [Ptr Value] -> IO (Ptr (Ptr Value))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packPtrArray [Ptr Value]
jParameters'
            Ptr (Ptr Value) -> IO (Ptr (Ptr Value))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr Value)
jParameters''
    Ptr Value
result <- Ptr Value -> CString -> Word32 -> Ptr (Ptr Value) -> IO (Ptr Value)
jsc_value_object_invoke_methodv Ptr Value
value' CString
name' Word32
nParameters Ptr (Ptr Value)
maybeParameters
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueObjectInvokeMethod" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Maybe [Value] -> ([Value] -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe [Value]
parameters ((Value -> IO ()) -> [Value] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr)
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Ptr (Ptr Value) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Value)
maybeParameters
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ValueObjectInvokeMethodMethodInfo
instance (signature ~ (T.Text -> Maybe ([Value]) -> m Value), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectInvokeMethodMethodInfo a signature where
    overloadedMethod = valueObjectInvokeMethod

instance O.OverloadedMethodInfo ValueObjectInvokeMethodMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectInvokeMethod",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectInvokeMethod"
        }


#endif

-- method Value::object_is_instance_of
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a class name" , 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 "jsc_value_object_is_instance_of" jsc_value_object_is_instance_of :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Get whether the value referenced by /@value@/ is an instance of class /@name@/.
valueObjectIsInstanceOf ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@name@/: a class name
    -> m Bool
    -- ^ __Returns:__ whether the value is an object instance of class /@name@/.
valueObjectIsInstanceOf :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Text -> m Bool
valueObjectIsInstanceOf a
value Text
name = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr Value -> CString -> IO CInt
jsc_value_object_is_instance_of Ptr Value
value' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueObjectIsInstanceOfMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueObjectIsInstanceOfMethodInfo a signature where
    overloadedMethod = valueObjectIsInstanceOf

instance O.OverloadedMethodInfo ValueObjectIsInstanceOfMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectIsInstanceOf",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectIsInstanceOf"
        }


#endif

-- method Value::object_set_property
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the property name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #JSCValue to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_set_property" jsc_value_object_set_property :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Value ->                            -- property : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO ()

-- | Set /@property@/ with /@name@/ on /@value@/.
valueObjectSetProperty ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a, IsValue b) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> T.Text
    -- ^ /@name@/: the property name
    -> b
    -- ^ /@property@/: the t'GI.JavaScriptCore.Objects.Value.Value' to set
    -> m ()
valueObjectSetProperty :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsValue a, IsValue b) =>
a -> Text -> b -> m ()
valueObjectSetProperty a
value Text
name b
property = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Value
property' <- b -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
property
    Ptr Value -> CString -> Ptr Value -> IO ()
jsc_value_object_set_property Ptr Value
value' CString
name' Ptr Value
property'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
property
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ValueObjectSetPropertyMethodInfo
instance (signature ~ (T.Text -> b -> m ()), MonadIO m, IsValue a, IsValue b) => O.OverloadedMethod ValueObjectSetPropertyMethodInfo a signature where
    overloadedMethod = valueObjectSetProperty

instance O.OverloadedMethodInfo ValueObjectSetPropertyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectSetProperty",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectSetProperty"
        }


#endif

-- method Value::object_set_property_at_index
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 property index" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "property"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #JSCValue to set"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_object_set_property_at_index" jsc_value_object_set_property_at_index :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    Word32 ->                               -- index : TBasicType TUInt
    Ptr Value ->                            -- property : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO ()

-- | Set /@property@/ at /@index@/ on /@value@/.
valueObjectSetPropertyAtIndex ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a, IsValue b) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> Word32
    -- ^ /@index@/: the property index
    -> b
    -- ^ /@property@/: the t'GI.JavaScriptCore.Objects.Value.Value' to set
    -> m ()
valueObjectSetPropertyAtIndex :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsValue a, IsValue b) =>
a -> Word32 -> b -> m ()
valueObjectSetPropertyAtIndex a
value Word32
index b
property = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr Value
property' <- b -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
property
    Ptr Value -> Word32 -> Ptr Value -> IO ()
jsc_value_object_set_property_at_index Ptr Value
value' Word32
index Ptr Value
property'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
property
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ValueObjectSetPropertyAtIndexMethodInfo
instance (signature ~ (Word32 -> b -> m ()), MonadIO m, IsValue a, IsValue b) => O.OverloadedMethod ValueObjectSetPropertyAtIndexMethodInfo a signature where
    overloadedMethod = valueObjectSetPropertyAtIndex

instance O.OverloadedMethodInfo ValueObjectSetPropertyAtIndexMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueObjectSetPropertyAtIndex",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueObjectSetPropertyAtIndex"
        }


#endif

-- method Value::to_boolean
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_to_boolean" jsc_value_to_boolean :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CInt

-- | Convert /@value@/ to a boolean.
valueToBoolean ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Bool
    -- ^ __Returns:__ a t'P.Bool' result of the conversion.
valueToBoolean :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bool
valueToBoolean a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CInt
result <- Ptr Value -> IO CInt
jsc_value_to_boolean Ptr Value
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueToBooleanMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsValue a) => O.OverloadedMethod ValueToBooleanMethodInfo a signature where
    overloadedMethod = valueToBoolean

instance O.OverloadedMethodInfo ValueToBooleanMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueToBoolean",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueToBoolean"
        }


#endif

-- method Value::to_double
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_to_double" jsc_value_to_double :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CDouble

-- | Convert /@value@/ to a double.
valueToDouble ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Double
    -- ^ __Returns:__ a @/gdouble/@ result of the conversion.
valueToDouble :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Double
valueToDouble a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CDouble
result <- Ptr Value -> IO CDouble
jsc_value_to_double Ptr Value
value'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ValueToDoubleMethodInfo
instance (signature ~ (m Double), MonadIO m, IsValue a) => O.OverloadedMethod ValueToDoubleMethodInfo a signature where
    overloadedMethod = valueToDouble

instance O.OverloadedMethodInfo ValueToDoubleMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueToDouble",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueToDouble"
        }


#endif

-- method Value::to_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt32)
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_to_int32" jsc_value_to_int32 :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO Int32

-- | Convert /@value@/ to a @/gint32/@.
valueToInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m Int32
    -- ^ __Returns:__ a @/gint32/@ result of the conversion.
valueToInt32 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Int32
valueToInt32 a
value = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Int32
result <- Ptr Value -> IO Int32
jsc_value_to_int32 Ptr Value
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ValueToInt32MethodInfo
instance (signature ~ (m Int32), MonadIO m, IsValue a) => O.OverloadedMethod ValueToInt32MethodInfo a signature where
    overloadedMethod = valueToInt32

instance O.OverloadedMethodInfo ValueToInt32MethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueToInt32",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueToInt32"
        }


#endif

-- method Value::to_json
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "indent"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of spaces to indent when nesting."
--                 , 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 "jsc_value_to_json" jsc_value_to_json :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    Word32 ->                               -- indent : TBasicType TUInt
    IO CString

-- | Create a JSON string of /@value@/ serialization. If /@indent@/ is 0, the resulting JSON will
-- not contain newlines. The size of the indent is clamped to 10 spaces.
-- 
-- /Since: 2.28/
valueToJson ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> Word32
    -- ^ /@indent@/: The number of spaces to indent when nesting.
    -> m T.Text
    -- ^ __Returns:__ a null-terminated JSON string with serialization of /@value@/
valueToJson :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> Word32 -> m Text
valueToJson a
value Word32
indent = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
result <- Ptr Value -> Word32 -> IO CString
jsc_value_to_json Ptr Value
value' Word32
indent
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueToJson" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ValueToJsonMethodInfo
instance (signature ~ (Word32 -> m T.Text), MonadIO m, IsValue a) => O.OverloadedMethod ValueToJsonMethodInfo a signature where
    overloadedMethod = valueToJson

instance O.OverloadedMethodInfo ValueToJsonMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueToJson",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueToJson"
        }


#endif

-- method Value::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , 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 "jsc_value_to_string" jsc_value_to_string :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO CString

-- | Convert /@value@/ to a string. Use 'GI.JavaScriptCore.Objects.Value.valueToStringAsBytes' instead, if you need to
-- handle strings containing null characters.
valueToString ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m T.Text
    -- ^ __Returns:__ a null-terminated string result of the conversion.
valueToString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Text
valueToString a
value = 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 Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    CString
result <- Ptr Value -> IO CString
jsc_value_to_string Ptr Value
value'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ValueToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsValue a) => O.OverloadedMethod ValueToStringMethodInfo a signature where
    overloadedMethod = valueToString

instance O.OverloadedMethodInfo ValueToStringMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueToString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueToString"
        }


#endif

-- method Value::to_string_as_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_value_to_string_as_bytes" jsc_value_to_string_as_bytes :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO (Ptr GLib.Bytes.Bytes)

-- | Convert /@value@/ to a string and return the results as t'GI.GLib.Structs.Bytes.Bytes'. This is needed
-- to handle strings with null characters.
valueToStringAsBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m GLib.Bytes.Bytes
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes' with the result of the conversion.
valueToStringAsBytes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsValue a) =>
a -> m Bytes
valueToStringAsBytes a
value = IO Bytes -> m Bytes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
value
    Ptr Bytes
result <- Ptr Value -> IO (Ptr Bytes)
jsc_value_to_string_as_bytes Ptr Value
value'
    Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"valueToStringAsBytes" Ptr Bytes
result
    Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
value
    Bytes -> IO Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'

#if defined(ENABLE_OVERLOADING)
data ValueToStringAsBytesMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m, IsValue a) => O.OverloadedMethod ValueToStringAsBytesMethodInfo a signature where
    overloadedMethod = valueToStringAsBytes

instance O.OverloadedMethodInfo ValueToStringAsBytesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.JavaScriptCore.Objects.Value.valueToStringAsBytes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-javascriptcore-4.0.23/docs/GI-JavaScriptCore-Objects-Value.html#v:valueToStringAsBytes"
        }


#endif