-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria

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

module GI.JavaScriptCore.Callbacks
    ( 

 -- * Signals
-- ** ClassDeletePropertyFunction #signal:ClassDeletePropertyFunction#

    C_ClassDeletePropertyFunction           ,
    ClassDeletePropertyFunction             ,
    dynamic_ClassDeletePropertyFunction     ,
    genClosure_ClassDeletePropertyFunction  ,
    mk_ClassDeletePropertyFunction          ,
    noClassDeletePropertyFunction           ,
    wrap_ClassDeletePropertyFunction        ,


-- ** ClassEnumeratePropertiesFunction #signal:ClassEnumeratePropertiesFunction#

    C_ClassEnumeratePropertiesFunction      ,
    ClassEnumeratePropertiesFunction        ,
    dynamic_ClassEnumeratePropertiesFunction,
    genClosure_ClassEnumeratePropertiesFunction,
    mk_ClassEnumeratePropertiesFunction     ,
    noClassEnumeratePropertiesFunction      ,
    wrap_ClassEnumeratePropertiesFunction   ,


-- ** ClassGetPropertyFunction #signal:ClassGetPropertyFunction#

    C_ClassGetPropertyFunction              ,
    ClassGetPropertyFunction                ,
    dynamic_ClassGetPropertyFunction        ,
    genClosure_ClassGetPropertyFunction     ,
    mk_ClassGetPropertyFunction             ,
    noClassGetPropertyFunction              ,
    wrap_ClassGetPropertyFunction           ,


-- ** ClassHasPropertyFunction #signal:ClassHasPropertyFunction#

    C_ClassHasPropertyFunction              ,
    ClassHasPropertyFunction                ,
    dynamic_ClassHasPropertyFunction        ,
    genClosure_ClassHasPropertyFunction     ,
    mk_ClassHasPropertyFunction             ,
    noClassHasPropertyFunction              ,
    wrap_ClassHasPropertyFunction           ,


-- ** ClassSetPropertyFunction #signal:ClassSetPropertyFunction#

    C_ClassSetPropertyFunction              ,
    ClassSetPropertyFunction                ,
    dynamic_ClassSetPropertyFunction        ,
    genClosure_ClassSetPropertyFunction     ,
    mk_ClassSetPropertyFunction             ,
    noClassSetPropertyFunction              ,
    wrap_ClassSetPropertyFunction           ,


-- ** ExceptionHandler #signal:ExceptionHandler#

    C_ExceptionHandler                      ,
    ExceptionHandler                        ,
    ExceptionHandler_WithClosures           ,
    drop_closures_ExceptionHandler          ,
    dynamic_ExceptionHandler                ,
    genClosure_ExceptionHandler             ,
    mk_ExceptionHandler                     ,
    noExceptionHandler                      ,
    noExceptionHandler_WithClosures         ,
    wrap_ExceptionHandler                   ,


-- ** OptionsFunc #signal:OptionsFunc#

    C_OptionsFunc                           ,
    OptionsFunc                             ,
    OptionsFunc_WithClosures                ,
    drop_closures_OptionsFunc               ,
    dynamic_OptionsFunc                     ,
    genClosure_OptionsFunc                  ,
    mk_OptionsFunc                          ,
    noOptionsFunc                           ,
    noOptionsFunc_WithClosures              ,
    wrap_OptionsFunc                        ,




    ) 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.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 {-# SOURCE #-} qualified GI.JavaScriptCore.Enums as JavaScriptCore.Enums
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Class as JavaScriptCore.Class
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Context as JavaScriptCore.Context
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Exception as JavaScriptCore.Exception
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Value as JavaScriptCore.Value

-- callback OptionsFunc
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just "%TRUE to stop the iteration, or %FALSE otherwise"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "option"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the option name" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "type"
          , argType =
              TInterface
                Name { namespace = "JavaScriptCore" , name = "OptionType" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "the option #JSCOptionType"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "description"
          , argType = TBasicType TUTF8
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "the option description, or %NULL"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "user data" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 3
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Function used to iterate options.\n\nNot that @description string is not localized."
        , sinceVersion = Just "2.24"
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_OptionsFunc =
    CString ->
    CUInt ->
    CString ->
    Ptr () ->
    IO CInt

-- Args: [ Arg
--           { argCName = "option"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the option name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "OptionType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the option #JSCOptionType"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "description"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the option description, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_OptionsFunc :: FunPtr C_OptionsFunc -> C_OptionsFunc

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_OptionsFunc ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    FunPtr C_OptionsFunc
    -> T.Text
    -- ^ /@option@/: the option name
    -> JavaScriptCore.Enums.OptionType
    -- ^ /@type@/: the option t'GI.JavaScriptCore.Enums.OptionType'
    -> Maybe (T.Text)
    -- ^ /@description@/: the option description, or 'P.Nothing'
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> m Bool
    -- ^ __Returns:__ 'P.True' to stop the iteration, or 'P.False' otherwise
dynamic_OptionsFunc :: FunPtr C_OptionsFunc
-> Text -> OptionType -> Maybe Text -> Ptr () -> m Bool
dynamic_OptionsFunc FunPtr C_OptionsFunc
__funPtr Text
option OptionType
type_ Maybe Text
description Ptr ()
userData = 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
    CString
option' <- Text -> IO CString
textToCString Text
option
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (OptionType -> Int) -> OptionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionType -> Int
forall a. Enum a => a -> Int
fromEnum) OptionType
type_
    CString
maybeDescription <- case Maybe Text
description of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jDescription -> do
            CString
jDescription' <- Text -> IO CString
textToCString Text
jDescription
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jDescription'
    CInt
result <- (FunPtr C_OptionsFunc -> C_OptionsFunc
__dynamic_C_OptionsFunc FunPtr C_OptionsFunc
__funPtr) CString
option' CUInt
type_' CString
maybeDescription Ptr ()
userData
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
option'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDescription
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_OptionsFunc`.
foreign import ccall "wrapper"
    mk_OptionsFunc :: C_OptionsFunc -> IO (FunPtr C_OptionsFunc)

-- | Function used to iterate options.
-- 
-- Not that /@description@/ string is not localized.
-- 
-- /Since: 2.24/
type OptionsFunc =
    T.Text
    -- ^ /@option@/: the option name
    -> JavaScriptCore.Enums.OptionType
    -- ^ /@type@/: the option t'GI.JavaScriptCore.Enums.OptionType'
    -> Maybe T.Text
    -- ^ /@description@/: the option description, or 'P.Nothing'
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop the iteration, or 'P.False' otherwise

-- | A convenience synonym for @`Nothing` :: `Maybe` `OptionsFunc`@.
noOptionsFunc :: Maybe OptionsFunc
noOptionsFunc :: Maybe OptionsFunc
noOptionsFunc = Maybe OptionsFunc
forall a. Maybe a
Nothing

-- | Function used to iterate options.
-- 
-- Not that /@description@/ string is not localized.
-- 
-- /Since: 2.24/
type OptionsFunc_WithClosures =
    T.Text
    -- ^ /@option@/: the option name
    -> JavaScriptCore.Enums.OptionType
    -- ^ /@type@/: the option t'GI.JavaScriptCore.Enums.OptionType'
    -> Maybe T.Text
    -- ^ /@description@/: the option description, or 'P.Nothing'
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> IO Bool
    -- ^ __Returns:__ 'P.True' to stop the iteration, or 'P.False' otherwise

-- | A convenience synonym for @`Nothing` :: `Maybe` `OptionsFunc_WithClosures`@.
noOptionsFunc_WithClosures :: Maybe OptionsFunc_WithClosures
noOptionsFunc_WithClosures :: Maybe OptionsFunc_WithClosures
noOptionsFunc_WithClosures = Maybe OptionsFunc_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_OptionsFunc :: OptionsFunc -> OptionsFunc_WithClosures
drop_closures_OptionsFunc :: OptionsFunc -> OptionsFunc_WithClosures
drop_closures_OptionsFunc OptionsFunc
_f Text
option OptionType
type_ Maybe Text
description Ptr ()
_ = OptionsFunc
_f Text
option OptionType
type_ Maybe Text
description

-- | Wrap the callback into a `GClosure`.
genClosure_OptionsFunc :: MonadIO m => OptionsFunc -> m (GClosure C_OptionsFunc)
genClosure_OptionsFunc :: OptionsFunc -> m (GClosure C_OptionsFunc)
genClosure_OptionsFunc OptionsFunc
cb = IO (GClosure C_OptionsFunc) -> m (GClosure C_OptionsFunc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_OptionsFunc) -> m (GClosure C_OptionsFunc))
-> IO (GClosure C_OptionsFunc) -> m (GClosure C_OptionsFunc)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: OptionsFunc_WithClosures
cb' = OptionsFunc -> OptionsFunc_WithClosures
drop_closures_OptionsFunc OptionsFunc
cb
    let cb'' :: C_OptionsFunc
cb'' = Maybe (Ptr (FunPtr C_OptionsFunc))
-> OptionsFunc_WithClosures -> C_OptionsFunc
wrap_OptionsFunc Maybe (Ptr (FunPtr C_OptionsFunc))
forall a. Maybe a
Nothing OptionsFunc_WithClosures
cb'
    C_OptionsFunc -> IO (FunPtr C_OptionsFunc)
mk_OptionsFunc C_OptionsFunc
cb'' IO (FunPtr C_OptionsFunc)
-> (FunPtr C_OptionsFunc -> IO (GClosure C_OptionsFunc))
-> IO (GClosure C_OptionsFunc)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_OptionsFunc -> IO (GClosure C_OptionsFunc)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `OptionsFunc` into a `C_OptionsFunc`.
wrap_OptionsFunc ::
    Maybe (Ptr (FunPtr C_OptionsFunc)) ->
    OptionsFunc_WithClosures ->
    C_OptionsFunc
wrap_OptionsFunc :: Maybe (Ptr (FunPtr C_OptionsFunc))
-> OptionsFunc_WithClosures -> C_OptionsFunc
wrap_OptionsFunc Maybe (Ptr (FunPtr C_OptionsFunc))
funptrptr OptionsFunc_WithClosures
_cb CString
option CUInt
type_ CString
description Ptr ()
userData = do
    Text
option' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
option
    let type_' :: OptionType
type_' = (Int -> OptionType
forall a. Enum a => Int -> a
toEnum (Int -> OptionType) -> (CUInt -> Int) -> CUInt -> OptionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
type_
    Maybe Text
maybeDescription <-
        if CString
description CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
        then Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        else do
            Text
description' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
description
            Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description'
    Bool
result <- OptionsFunc_WithClosures
_cb  Text
option' OptionType
type_' Maybe Text
maybeDescription Ptr ()
userData
    Maybe (Ptr (FunPtr C_OptionsFunc)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_OptionsFunc))
funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback ExceptionHandler
{- Callable
  { returnType = Nothing
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation { rawDocText = Nothing , sinceVersion = Nothing }
  , 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 = "exception"
          , argType =
              TInterface
                Name { namespace = "JavaScriptCore" , name = "Exception" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #JSCException" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , Arg
          { argCName = "user_data"
          , argType = TBasicType TPtr
          , direction = DirectionIn
          , mayBeNull = True
          , argDoc =
              Documentation
                { rawDocText = Just "user data" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = 2
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "Function used to handle JavaScript exceptions in a #JSCContext."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ExceptionHandler =
    Ptr JavaScriptCore.Context.Context ->
    Ptr JavaScriptCore.Exception.Exception ->
    Ptr () ->
    IO ()

-- 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 = "exception"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "Exception" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCException" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ExceptionHandler :: FunPtr C_ExceptionHandler -> C_ExceptionHandler

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ExceptionHandler ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Context.IsContext a, JavaScriptCore.Exception.IsException b) =>
    FunPtr C_ExceptionHandler
    -> a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> b
    -- ^ /@exception@/: a t'GI.JavaScriptCore.Objects.Exception.Exception'
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> m ()
dynamic_ExceptionHandler :: FunPtr C_ExceptionHandler -> a -> b -> Ptr () -> m ()
dynamic_ExceptionHandler FunPtr C_ExceptionHandler
__funPtr a
context b
exception Ptr ()
userData = 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 Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Exception
exception' <- b -> IO (Ptr Exception)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
exception
    (FunPtr C_ExceptionHandler -> C_ExceptionHandler
__dynamic_C_ExceptionHandler FunPtr C_ExceptionHandler
__funPtr) Ptr Context
context' Ptr Exception
exception' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
exception
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Generate a function pointer callable from C code, from a `C_ExceptionHandler`.
foreign import ccall "wrapper"
    mk_ExceptionHandler :: C_ExceptionHandler -> IO (FunPtr C_ExceptionHandler)

-- | Function used to handle JavaScript exceptions in a t'GI.JavaScriptCore.Objects.Context.Context'.
type ExceptionHandler =
    JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> JavaScriptCore.Exception.Exception
    -- ^ /@exception@/: a t'GI.JavaScriptCore.Objects.Exception.Exception'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ExceptionHandler`@.
noExceptionHandler :: Maybe ExceptionHandler
noExceptionHandler :: Maybe ExceptionHandler
noExceptionHandler = Maybe ExceptionHandler
forall a. Maybe a
Nothing

-- | Function used to handle JavaScript exceptions in a t'GI.JavaScriptCore.Objects.Context.Context'.
type ExceptionHandler_WithClosures =
    JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> JavaScriptCore.Exception.Exception
    -- ^ /@exception@/: a t'GI.JavaScriptCore.Objects.Exception.Exception'
    -> Ptr ()
    -- ^ /@userData@/: user data
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ExceptionHandler_WithClosures`@.
noExceptionHandler_WithClosures :: Maybe ExceptionHandler_WithClosures
noExceptionHandler_WithClosures :: Maybe ExceptionHandler_WithClosures
noExceptionHandler_WithClosures = Maybe ExceptionHandler_WithClosures
forall a. Maybe a
Nothing

-- | A simple wrapper that ignores the closure arguments.
drop_closures_ExceptionHandler :: ExceptionHandler -> ExceptionHandler_WithClosures
drop_closures_ExceptionHandler :: ExceptionHandler -> ExceptionHandler_WithClosures
drop_closures_ExceptionHandler ExceptionHandler
_f Context
context Exception
exception Ptr ()
_ = ExceptionHandler
_f Context
context Exception
exception

-- | Wrap the callback into a `GClosure`.
genClosure_ExceptionHandler :: MonadIO m => ExceptionHandler -> m (GClosure C_ExceptionHandler)
genClosure_ExceptionHandler :: ExceptionHandler -> m (GClosure C_ExceptionHandler)
genClosure_ExceptionHandler ExceptionHandler
cb = IO (GClosure C_ExceptionHandler) -> m (GClosure C_ExceptionHandler)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ExceptionHandler)
 -> m (GClosure C_ExceptionHandler))
-> IO (GClosure C_ExceptionHandler)
-> m (GClosure C_ExceptionHandler)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: ExceptionHandler_WithClosures
cb' = ExceptionHandler -> ExceptionHandler_WithClosures
drop_closures_ExceptionHandler ExceptionHandler
cb
    let cb'' :: C_ExceptionHandler
cb'' = Maybe (Ptr (FunPtr C_ExceptionHandler))
-> ExceptionHandler_WithClosures -> C_ExceptionHandler
wrap_ExceptionHandler Maybe (Ptr (FunPtr C_ExceptionHandler))
forall a. Maybe a
Nothing ExceptionHandler_WithClosures
cb'
    C_ExceptionHandler -> IO (FunPtr C_ExceptionHandler)
mk_ExceptionHandler C_ExceptionHandler
cb'' IO (FunPtr C_ExceptionHandler)
-> (FunPtr C_ExceptionHandler -> IO (GClosure C_ExceptionHandler))
-> IO (GClosure C_ExceptionHandler)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ExceptionHandler -> IO (GClosure C_ExceptionHandler)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ExceptionHandler` into a `C_ExceptionHandler`.
wrap_ExceptionHandler ::
    Maybe (Ptr (FunPtr C_ExceptionHandler)) ->
    ExceptionHandler_WithClosures ->
    C_ExceptionHandler
wrap_ExceptionHandler :: Maybe (Ptr (FunPtr C_ExceptionHandler))
-> ExceptionHandler_WithClosures -> C_ExceptionHandler
wrap_ExceptionHandler Maybe (Ptr (FunPtr C_ExceptionHandler))
funptrptr ExceptionHandler_WithClosures
_cb Ptr Context
context Ptr Exception
exception Ptr ()
userData = do
    Context
context' <- ((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
context
    Exception
exception' <- ((ManagedPtr Exception -> Exception)
-> Ptr Exception -> IO Exception
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Exception -> Exception
JavaScriptCore.Exception.Exception) Ptr Exception
exception
    ExceptionHandler_WithClosures
_cb  Context
context' Exception
exception' Ptr ()
userData
    Maybe (Ptr (FunPtr C_ExceptionHandler)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ExceptionHandler))
funptrptr


-- callback ClassSetPropertyFunction
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "%TRUE if handled or %FALSE to forward the request to the parent class or prototype chain."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "jsc_class"
          , argType =
              TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , 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 "the @jsc_class instance"
                , 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 = "value"
          , 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
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The type of set_property in #JSCClassVTable. This is only required when you need to handle\nexternal properties not added to the prototype."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ClassSetPropertyFunction =
    Ptr JavaScriptCore.Class.Class ->
    Ptr JavaScriptCore.Context.Context ->
    Ptr () ->
    CString ->
    Ptr JavaScriptCore.Value.Value ->
    IO CInt

-- Args: [ Arg
--           { argCName = "jsc_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 "the @jsc_class instance"
--                 , 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 = "value"
--           , 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: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dynamic" __dynamic_C_ClassSetPropertyFunction :: FunPtr C_ClassSetPropertyFunction -> C_ClassSetPropertyFunction

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ClassSetPropertyFunction ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Class.IsClass a, JavaScriptCore.Context.IsContext b, JavaScriptCore.Value.IsValue c) =>
    FunPtr C_ClassSetPropertyFunction
    -> a
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> b
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> c
    -- ^ /@value@/: the t'GI.JavaScriptCore.Objects.Value.Value' to set
    -> m Bool
    -- ^ __Returns:__ 'P.True' if handled or 'P.False' to forward the request to the parent class or prototype chain.
dynamic_ClassSetPropertyFunction :: FunPtr C_ClassSetPropertyFunction
-> a -> b -> Ptr () -> Text -> c -> m Bool
dynamic_ClassSetPropertyFunction FunPtr C_ClassSetPropertyFunction
__funPtr a
jscClass b
context Ptr ()
instance_ Text
name c
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 Class
jscClass' <- a -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jscClass
    Ptr Context
context' <- b -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Value
value' <- c -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
value
    CInt
result <- (FunPtr C_ClassSetPropertyFunction -> C_ClassSetPropertyFunction
__dynamic_C_ClassSetPropertyFunction FunPtr C_ClassSetPropertyFunction
__funPtr) Ptr Class
jscClass' Ptr Context
context' Ptr ()
instance_ CString
name' 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
jscClass
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
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'

-- | Generate a function pointer callable from C code, from a `C_ClassSetPropertyFunction`.
foreign import ccall "wrapper"
    mk_ClassSetPropertyFunction :: C_ClassSetPropertyFunction -> IO (FunPtr C_ClassSetPropertyFunction)

-- | The type of set_property in t'GI.JavaScriptCore.Structs.ClassVTable.ClassVTable'. This is only required when you need to handle
-- external properties not added to the prototype.
type ClassSetPropertyFunction =
    JavaScriptCore.Class.Class
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> JavaScriptCore.Value.Value
    -- ^ /@value@/: the t'GI.JavaScriptCore.Objects.Value.Value' to set
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if handled or 'P.False' to forward the request to the parent class or prototype chain.

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassSetPropertyFunction`@.
noClassSetPropertyFunction :: Maybe ClassSetPropertyFunction
noClassSetPropertyFunction :: Maybe ClassSetPropertyFunction
noClassSetPropertyFunction = Maybe ClassSetPropertyFunction
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ClassSetPropertyFunction :: MonadIO m => ClassSetPropertyFunction -> m (GClosure C_ClassSetPropertyFunction)
genClosure_ClassSetPropertyFunction :: ClassSetPropertyFunction -> m (GClosure C_ClassSetPropertyFunction)
genClosure_ClassSetPropertyFunction ClassSetPropertyFunction
cb = IO (GClosure C_ClassSetPropertyFunction)
-> m (GClosure C_ClassSetPropertyFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassSetPropertyFunction)
 -> m (GClosure C_ClassSetPropertyFunction))
-> IO (GClosure C_ClassSetPropertyFunction)
-> m (GClosure C_ClassSetPropertyFunction)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassSetPropertyFunction
cb' = Maybe (Ptr (FunPtr C_ClassSetPropertyFunction))
-> ClassSetPropertyFunction -> C_ClassSetPropertyFunction
wrap_ClassSetPropertyFunction Maybe (Ptr (FunPtr C_ClassSetPropertyFunction))
forall a. Maybe a
Nothing ClassSetPropertyFunction
cb
    C_ClassSetPropertyFunction
-> IO (FunPtr C_ClassSetPropertyFunction)
mk_ClassSetPropertyFunction C_ClassSetPropertyFunction
cb' IO (FunPtr C_ClassSetPropertyFunction)
-> (FunPtr C_ClassSetPropertyFunction
    -> IO (GClosure C_ClassSetPropertyFunction))
-> IO (GClosure C_ClassSetPropertyFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassSetPropertyFunction
-> IO (GClosure C_ClassSetPropertyFunction)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassSetPropertyFunction` into a `C_ClassSetPropertyFunction`.
wrap_ClassSetPropertyFunction ::
    Maybe (Ptr (FunPtr C_ClassSetPropertyFunction)) ->
    ClassSetPropertyFunction ->
    C_ClassSetPropertyFunction
wrap_ClassSetPropertyFunction :: Maybe (Ptr (FunPtr C_ClassSetPropertyFunction))
-> ClassSetPropertyFunction -> C_ClassSetPropertyFunction
wrap_ClassSetPropertyFunction Maybe (Ptr (FunPtr C_ClassSetPropertyFunction))
funptrptr ClassSetPropertyFunction
_cb Ptr Class
jscClass Ptr Context
context Ptr ()
instance_ CString
name Ptr Value
value = do
    Class
jscClass' <- ((ManagedPtr Class -> Class) -> Ptr Class -> IO Class
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Class -> Class
JavaScriptCore.Class.Class) Ptr Class
jscClass
    Context
context' <- ((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
context
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Value
value' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
value
    Bool
result <- ClassSetPropertyFunction
_cb  Class
jscClass' Context
context' Ptr ()
instance_ Text
name' Value
value'
    Maybe (Ptr (FunPtr C_ClassSetPropertyFunction)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ClassSetPropertyFunction))
funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback ClassHasPropertyFunction
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "%TRUE if @instance has a property with @name or %FALSE to forward the request\n   to the parent class or prototype chain."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "jsc_class"
          , argType =
              TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , 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 "the @jsc_class instance"
                , 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
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The type of has_property in #JSCClassVTable. This is only required when you need to handle\nexternal properties not added to the prototype."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ClassHasPropertyFunction =
    Ptr JavaScriptCore.Class.Class ->
    Ptr JavaScriptCore.Context.Context ->
    Ptr () ->
    CString ->
    IO CInt

-- Args: [ Arg
--           { argCName = "jsc_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 "the @jsc_class instance"
--                 , 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 "dynamic" __dynamic_C_ClassHasPropertyFunction :: FunPtr C_ClassHasPropertyFunction -> C_ClassHasPropertyFunction

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ClassHasPropertyFunction ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Class.IsClass a, JavaScriptCore.Context.IsContext b) =>
    FunPtr C_ClassHasPropertyFunction
    -> a
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> b
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@instance@/ has a property with /@name@/ or 'P.False' to forward the request
    --    to the parent class or prototype chain.
dynamic_ClassHasPropertyFunction :: FunPtr C_ClassHasPropertyFunction
-> a -> b -> Ptr () -> Text -> m Bool
dynamic_ClassHasPropertyFunction FunPtr C_ClassHasPropertyFunction
__funPtr a
jscClass b
context Ptr ()
instance_ 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 Class
jscClass' <- a -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jscClass
    Ptr Context
context' <- b -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- (FunPtr C_ClassHasPropertyFunction -> C_ClassHasPropertyFunction
__dynamic_C_ClassHasPropertyFunction FunPtr C_ClassHasPropertyFunction
__funPtr) Ptr Class
jscClass' Ptr Context
context' Ptr ()
instance_ 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
jscClass
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_ClassHasPropertyFunction`.
foreign import ccall "wrapper"
    mk_ClassHasPropertyFunction :: C_ClassHasPropertyFunction -> IO (FunPtr C_ClassHasPropertyFunction)

-- | The type of has_property in t'GI.JavaScriptCore.Structs.ClassVTable.ClassVTable'. This is only required when you need to handle
-- external properties not added to the prototype.
type ClassHasPropertyFunction =
    JavaScriptCore.Class.Class
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if /@instance@/ has a property with /@name@/ or 'P.False' to forward the request
    --    to the parent class or prototype chain.

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassHasPropertyFunction`@.
noClassHasPropertyFunction :: Maybe ClassHasPropertyFunction
noClassHasPropertyFunction :: Maybe ClassHasPropertyFunction
noClassHasPropertyFunction = Maybe ClassHasPropertyFunction
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ClassHasPropertyFunction :: MonadIO m => ClassHasPropertyFunction -> m (GClosure C_ClassHasPropertyFunction)
genClosure_ClassHasPropertyFunction :: ClassHasPropertyFunction -> m (GClosure C_ClassHasPropertyFunction)
genClosure_ClassHasPropertyFunction ClassHasPropertyFunction
cb = IO (GClosure C_ClassHasPropertyFunction)
-> m (GClosure C_ClassHasPropertyFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassHasPropertyFunction)
 -> m (GClosure C_ClassHasPropertyFunction))
-> IO (GClosure C_ClassHasPropertyFunction)
-> m (GClosure C_ClassHasPropertyFunction)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassHasPropertyFunction
cb' = Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
-> ClassHasPropertyFunction -> C_ClassHasPropertyFunction
wrap_ClassHasPropertyFunction Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
forall a. Maybe a
Nothing ClassHasPropertyFunction
cb
    C_ClassHasPropertyFunction
-> IO (FunPtr C_ClassHasPropertyFunction)
mk_ClassHasPropertyFunction C_ClassHasPropertyFunction
cb' IO (FunPtr C_ClassHasPropertyFunction)
-> (FunPtr C_ClassHasPropertyFunction
    -> IO (GClosure C_ClassHasPropertyFunction))
-> IO (GClosure C_ClassHasPropertyFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassHasPropertyFunction
-> IO (GClosure C_ClassHasPropertyFunction)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassHasPropertyFunction` into a `C_ClassHasPropertyFunction`.
wrap_ClassHasPropertyFunction ::
    Maybe (Ptr (FunPtr C_ClassHasPropertyFunction)) ->
    ClassHasPropertyFunction ->
    C_ClassHasPropertyFunction
wrap_ClassHasPropertyFunction :: Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
-> ClassHasPropertyFunction -> C_ClassHasPropertyFunction
wrap_ClassHasPropertyFunction Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
funptrptr ClassHasPropertyFunction
_cb Ptr Class
jscClass Ptr Context
context Ptr ()
instance_ CString
name = do
    Class
jscClass' <- ((ManagedPtr Class -> Class) -> Ptr Class -> IO Class
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Class -> Class
JavaScriptCore.Class.Class) Ptr Class
jscClass
    Context
context' <- ((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
context
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Bool
result <- ClassHasPropertyFunction
_cb  Class
jscClass' Context
context' Ptr ()
instance_ Text
name'
    Maybe (Ptr (FunPtr C_ClassHasPropertyFunction)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- callback ClassGetPropertyFunction
{- Callable
  { returnType =
      Just
        (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
  , returnMayBeNull = True
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "a #JSCValue or %NULL to forward the request to\n   the parent class or prototype chain"
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "jsc_class"
          , argType =
              TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , 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 "the @jsc_class instance"
                , 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
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The type of get_property in #JSCClassVTable. This is only required when you need to handle\nexternal properties not added to the prototype."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ClassGetPropertyFunction =
    Ptr JavaScriptCore.Class.Class ->
    Ptr JavaScriptCore.Context.Context ->
    Ptr () ->
    CString ->
    IO (Ptr JavaScriptCore.Value.Value)

-- Args: [ Arg
--           { argCName = "jsc_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 "the @jsc_class instance"
--                 , 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 "dynamic" __dynamic_C_ClassGetPropertyFunction :: FunPtr C_ClassGetPropertyFunction -> C_ClassGetPropertyFunction

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ClassGetPropertyFunction ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Class.IsClass a, JavaScriptCore.Context.IsContext b) =>
    FunPtr C_ClassGetPropertyFunction
    -> a
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> b
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> m (Maybe JavaScriptCore.Value.Value)
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' or 'P.Nothing' to forward the request to
    --    the parent class or prototype chain
dynamic_ClassGetPropertyFunction :: FunPtr C_ClassGetPropertyFunction
-> a -> b -> Ptr () -> Text -> m (Maybe Value)
dynamic_ClassGetPropertyFunction FunPtr C_ClassGetPropertyFunction
__funPtr a
jscClass b
context Ptr ()
instance_ Text
name = IO (Maybe Value) -> m (Maybe Value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Value) -> m (Maybe Value))
-> IO (Maybe Value) -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Class
jscClass' <- a -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jscClass
    Ptr Context
context' <- b -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Value
result <- (FunPtr C_ClassGetPropertyFunction -> C_ClassGetPropertyFunction
__dynamic_C_ClassGetPropertyFunction FunPtr C_ClassGetPropertyFunction
__funPtr) Ptr Class
jscClass' Ptr Context
context' Ptr ()
instance_ CString
name'
    Maybe Value
maybeResult <- Ptr Value -> (Ptr Value -> IO Value) -> IO (Maybe Value)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Value
result ((Ptr Value -> IO Value) -> IO (Maybe Value))
-> (Ptr Value -> IO Value) -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ \Ptr Value
result' -> do
        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
JavaScriptCore.Value.Value) Ptr Value
result'
        Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
jscClass
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Maybe Value -> IO (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
maybeResult

-- | Generate a function pointer callable from C code, from a `C_ClassGetPropertyFunction`.
foreign import ccall "wrapper"
    mk_ClassGetPropertyFunction :: C_ClassGetPropertyFunction -> IO (FunPtr C_ClassGetPropertyFunction)

-- | The type of get_property in t'GI.JavaScriptCore.Structs.ClassVTable.ClassVTable'. This is only required when you need to handle
-- external properties not added to the prototype.
type ClassGetPropertyFunction =
    JavaScriptCore.Class.Class
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> IO (Maybe JavaScriptCore.Value.Value)
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' or 'P.Nothing' to forward the request to
    --    the parent class or prototype chain

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassGetPropertyFunction`@.
noClassGetPropertyFunction :: Maybe ClassGetPropertyFunction
noClassGetPropertyFunction :: Maybe ClassGetPropertyFunction
noClassGetPropertyFunction = Maybe ClassGetPropertyFunction
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ClassGetPropertyFunction :: MonadIO m => ClassGetPropertyFunction -> m (GClosure C_ClassGetPropertyFunction)
genClosure_ClassGetPropertyFunction :: ClassGetPropertyFunction -> m (GClosure C_ClassGetPropertyFunction)
genClosure_ClassGetPropertyFunction ClassGetPropertyFunction
cb = IO (GClosure C_ClassGetPropertyFunction)
-> m (GClosure C_ClassGetPropertyFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassGetPropertyFunction)
 -> m (GClosure C_ClassGetPropertyFunction))
-> IO (GClosure C_ClassGetPropertyFunction)
-> m (GClosure C_ClassGetPropertyFunction)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassGetPropertyFunction
cb' = Maybe (Ptr (FunPtr C_ClassGetPropertyFunction))
-> ClassGetPropertyFunction -> C_ClassGetPropertyFunction
wrap_ClassGetPropertyFunction Maybe (Ptr (FunPtr C_ClassGetPropertyFunction))
forall a. Maybe a
Nothing ClassGetPropertyFunction
cb
    C_ClassGetPropertyFunction
-> IO (FunPtr C_ClassGetPropertyFunction)
mk_ClassGetPropertyFunction C_ClassGetPropertyFunction
cb' IO (FunPtr C_ClassGetPropertyFunction)
-> (FunPtr C_ClassGetPropertyFunction
    -> IO (GClosure C_ClassGetPropertyFunction))
-> IO (GClosure C_ClassGetPropertyFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassGetPropertyFunction
-> IO (GClosure C_ClassGetPropertyFunction)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassGetPropertyFunction` into a `C_ClassGetPropertyFunction`.
wrap_ClassGetPropertyFunction ::
    Maybe (Ptr (FunPtr C_ClassGetPropertyFunction)) ->
    ClassGetPropertyFunction ->
    C_ClassGetPropertyFunction
wrap_ClassGetPropertyFunction :: Maybe (Ptr (FunPtr C_ClassGetPropertyFunction))
-> ClassGetPropertyFunction -> C_ClassGetPropertyFunction
wrap_ClassGetPropertyFunction Maybe (Ptr (FunPtr C_ClassGetPropertyFunction))
funptrptr ClassGetPropertyFunction
_cb Ptr Class
jscClass Ptr Context
context Ptr ()
instance_ CString
name = do
    Class
jscClass' <- ((ManagedPtr Class -> Class) -> Ptr Class -> IO Class
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Class -> Class
JavaScriptCore.Class.Class) Ptr Class
jscClass
    Context
context' <- ((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
context
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Maybe Value
result <- ClassGetPropertyFunction
_cb  Class
jscClass' Context
context' Ptr ()
instance_ Text
name'
    Maybe (Ptr (FunPtr C_ClassGetPropertyFunction)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ClassGetPropertyFunction))
funptrptr
    Ptr Value
-> Maybe Value -> (Value -> IO (Ptr Value)) -> IO (Ptr Value)
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM Ptr Value
forall a. Ptr a
nullPtr Maybe Value
result ((Value -> IO (Ptr Value)) -> IO (Ptr Value))
-> (Value -> IO (Ptr Value)) -> IO (Ptr Value)
forall a b. (a -> b) -> a -> b
$ \Value
result' -> do
        Ptr Value
result'' <- Value -> IO (Ptr Value)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject Value
result'
        Ptr Value -> IO (Ptr Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Value
result''


-- callback ClassEnumeratePropertiesFunction
{- Callable
  { returnType = Just (TCArray True (-1) (-1) (TBasicType TUTF8))
  , returnMayBeNull = True
  , returnTransfer = TransferEverything
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "a %NULL-terminated array of strings\n   containing the property names, or %NULL if @instance doesn't have enumerable properties."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "jsc_class"
          , argType =
              TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , 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 "the @jsc_class instance"
                , sinceVersion = Nothing
                }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The type of enumerate_properties in #JSCClassVTable. This is only required when you need to handle\nexternal properties not added to the prototype."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ClassEnumeratePropertiesFunction =
    Ptr JavaScriptCore.Class.Class ->
    Ptr JavaScriptCore.Context.Context ->
    Ptr () ->
    IO (Ptr CString)

-- Args: [ Arg
--           { argCName = "jsc_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 "the @jsc_class instance"
--                 , 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 "dynamic" __dynamic_C_ClassEnumeratePropertiesFunction :: FunPtr C_ClassEnumeratePropertiesFunction -> C_ClassEnumeratePropertiesFunction

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ClassEnumeratePropertiesFunction ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Class.IsClass a, JavaScriptCore.Context.IsContext b) =>
    FunPtr C_ClassEnumeratePropertiesFunction
    -> a
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> b
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> m (Maybe [T.Text])
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of strings
    --    containing the property names, or 'P.Nothing' if /@instance@/ doesn\'t have enumerable properties.
dynamic_ClassEnumeratePropertiesFunction :: FunPtr C_ClassEnumeratePropertiesFunction
-> a -> b -> Ptr () -> m (Maybe [Text])
dynamic_ClassEnumeratePropertiesFunction FunPtr C_ClassEnumeratePropertiesFunction
__funPtr a
jscClass b
context Ptr ()
instance_ = 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 Class
jscClass' <- a -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jscClass
    Ptr Context
context' <- b -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    Ptr CString
result <- (FunPtr C_ClassEnumeratePropertiesFunction
-> C_ClassEnumeratePropertiesFunction
__dynamic_C_ClassEnumeratePropertiesFunction FunPtr C_ClassEnumeratePropertiesFunction
__funPtr) Ptr Class
jscClass' Ptr Context
context' Ptr ()
instance_
    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
jscClass
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
maybeResult

-- | Generate a function pointer callable from C code, from a `C_ClassEnumeratePropertiesFunction`.
foreign import ccall "wrapper"
    mk_ClassEnumeratePropertiesFunction :: C_ClassEnumeratePropertiesFunction -> IO (FunPtr C_ClassEnumeratePropertiesFunction)

-- | The type of enumerate_properties in t'GI.JavaScriptCore.Structs.ClassVTable.ClassVTable'. This is only required when you need to handle
-- external properties not added to the prototype.
type ClassEnumeratePropertiesFunction =
    JavaScriptCore.Class.Class
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> IO (Maybe [T.Text])
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of strings
    --    containing the property names, or 'P.Nothing' if /@instance@/ doesn\'t have enumerable properties.

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassEnumeratePropertiesFunction`@.
noClassEnumeratePropertiesFunction :: Maybe ClassEnumeratePropertiesFunction
noClassEnumeratePropertiesFunction :: Maybe ClassEnumeratePropertiesFunction
noClassEnumeratePropertiesFunction = Maybe ClassEnumeratePropertiesFunction
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ClassEnumeratePropertiesFunction :: MonadIO m => ClassEnumeratePropertiesFunction -> m (GClosure C_ClassEnumeratePropertiesFunction)
genClosure_ClassEnumeratePropertiesFunction :: ClassEnumeratePropertiesFunction
-> m (GClosure C_ClassEnumeratePropertiesFunction)
genClosure_ClassEnumeratePropertiesFunction ClassEnumeratePropertiesFunction
cb = IO (GClosure C_ClassEnumeratePropertiesFunction)
-> m (GClosure C_ClassEnumeratePropertiesFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassEnumeratePropertiesFunction)
 -> m (GClosure C_ClassEnumeratePropertiesFunction))
-> IO (GClosure C_ClassEnumeratePropertiesFunction)
-> m (GClosure C_ClassEnumeratePropertiesFunction)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassEnumeratePropertiesFunction
cb' = Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction))
-> ClassEnumeratePropertiesFunction
-> C_ClassEnumeratePropertiesFunction
wrap_ClassEnumeratePropertiesFunction Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction))
forall a. Maybe a
Nothing ClassEnumeratePropertiesFunction
cb
    C_ClassEnumeratePropertiesFunction
-> IO (FunPtr C_ClassEnumeratePropertiesFunction)
mk_ClassEnumeratePropertiesFunction C_ClassEnumeratePropertiesFunction
cb' IO (FunPtr C_ClassEnumeratePropertiesFunction)
-> (FunPtr C_ClassEnumeratePropertiesFunction
    -> IO (GClosure C_ClassEnumeratePropertiesFunction))
-> IO (GClosure C_ClassEnumeratePropertiesFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassEnumeratePropertiesFunction
-> IO (GClosure C_ClassEnumeratePropertiesFunction)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassEnumeratePropertiesFunction` into a `C_ClassEnumeratePropertiesFunction`.
wrap_ClassEnumeratePropertiesFunction ::
    Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction)) ->
    ClassEnumeratePropertiesFunction ->
    C_ClassEnumeratePropertiesFunction
wrap_ClassEnumeratePropertiesFunction :: Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction))
-> ClassEnumeratePropertiesFunction
-> C_ClassEnumeratePropertiesFunction
wrap_ClassEnumeratePropertiesFunction Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction))
funptrptr ClassEnumeratePropertiesFunction
_cb Ptr Class
jscClass Ptr Context
context Ptr ()
instance_ = do
    Class
jscClass' <- ((ManagedPtr Class -> Class) -> Ptr Class -> IO Class
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Class -> Class
JavaScriptCore.Class.Class) Ptr Class
jscClass
    Context
context' <- ((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
context
    Maybe [Text]
result <- ClassEnumeratePropertiesFunction
_cb  Class
jscClass' Context
context' Ptr ()
instance_
    Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ClassEnumeratePropertiesFunction))
funptrptr
    Ptr CString
-> Maybe [Text] -> ([Text] -> IO (Ptr CString)) -> IO (Ptr CString)
forall (m :: * -> *) b a.
Monad m =>
b -> Maybe a -> (a -> m b) -> m b
maybeM Ptr CString
forall a. Ptr a
nullPtr Maybe [Text]
result (([Text] -> IO (Ptr CString)) -> IO (Ptr CString))
-> ([Text] -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ \[Text]
result' -> do
        Ptr CString
result'' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
result'
        Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
result''


-- callback ClassDeletePropertyFunction
{- Callable
  { returnType = Just (TBasicType TBoolean)
  , returnMayBeNull = False
  , returnTransfer = TransferNothing
  , returnDocumentation =
      Documentation
        { rawDocText =
            Just
              "%TRUE if handled or %FALSE to to forward the request to the parent class or prototype chain."
        , sinceVersion = Nothing
        }
  , args =
      [ Arg
          { argCName = "jsc_class"
          , argType =
              TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
          , direction = DirectionIn
          , mayBeNull = False
          , argDoc =
              Documentation
                { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
          , argScope = ScopeTypeInvalid
          , argClosure = -1
          , argDestroy = -1
          , argCallerAllocates = False
          , transfer = TransferNothing
          }
      , 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 "the @jsc_class instance"
                , 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
          }
      ]
  , skipReturn = False
  , callableThrows = False
  , callableDeprecated = Nothing
  , callableDocumentation =
      Documentation
        { rawDocText =
            Just
              "The type of delete_property in #JSCClassVTable. This is only required when you need to handle\nexternal properties not added to the prototype."
        , sinceVersion = Nothing
        }
  , callableResolvable = Nothing
  }
-}
-- | Type for the callback on the (unwrapped) C side.
type C_ClassDeletePropertyFunction =
    Ptr JavaScriptCore.Class.Class ->
    Ptr JavaScriptCore.Context.Context ->
    Ptr () ->
    CString ->
    IO CInt

-- Args: [ Arg
--           { argCName = "jsc_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , 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 "the @jsc_class instance"
--                 , 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 "dynamic" __dynamic_C_ClassDeletePropertyFunction :: FunPtr C_ClassDeletePropertyFunction -> C_ClassDeletePropertyFunction

-- | Given a pointer to a foreign C function, wrap it into a function callable from Haskell.
dynamic_ClassDeletePropertyFunction ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.Class.IsClass a, JavaScriptCore.Context.IsContext b) =>
    FunPtr C_ClassDeletePropertyFunction
    -> a
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> b
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> m Bool
    -- ^ __Returns:__ 'P.True' if handled or 'P.False' to to forward the request to the parent class or prototype chain.
dynamic_ClassDeletePropertyFunction :: FunPtr C_ClassHasPropertyFunction
-> a -> b -> Ptr () -> Text -> m Bool
dynamic_ClassDeletePropertyFunction FunPtr C_ClassHasPropertyFunction
__funPtr a
jscClass b
context Ptr ()
instance_ 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 Class
jscClass' <- a -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jscClass
    Ptr Context
context' <- b -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
context
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- (FunPtr C_ClassHasPropertyFunction -> C_ClassHasPropertyFunction
__dynamic_C_ClassDeletePropertyFunction FunPtr C_ClassHasPropertyFunction
__funPtr) Ptr Class
jscClass' Ptr Context
context' Ptr ()
instance_ 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
jscClass
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

-- | Generate a function pointer callable from C code, from a `C_ClassDeletePropertyFunction`.
foreign import ccall "wrapper"
    mk_ClassDeletePropertyFunction :: C_ClassDeletePropertyFunction -> IO (FunPtr C_ClassDeletePropertyFunction)

-- | The type of delete_property in t'GI.JavaScriptCore.Structs.ClassVTable.ClassVTable'. This is only required when you need to handle
-- external properties not added to the prototype.
type ClassDeletePropertyFunction =
    JavaScriptCore.Class.Class
    -- ^ /@jscClass@/: a t'GI.JavaScriptCore.Objects.Class.Class'
    -> JavaScriptCore.Context.Context
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> Ptr ()
    -- ^ /@instance@/: the /@jscClass@/ instance
    -> T.Text
    -- ^ /@name@/: the property name
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if handled or 'P.False' to to forward the request to the parent class or prototype chain.

-- | A convenience synonym for @`Nothing` :: `Maybe` `ClassDeletePropertyFunction`@.
noClassDeletePropertyFunction :: Maybe ClassDeletePropertyFunction
noClassDeletePropertyFunction :: Maybe ClassHasPropertyFunction
noClassDeletePropertyFunction = Maybe ClassHasPropertyFunction
forall a. Maybe a
Nothing

-- | Wrap the callback into a `GClosure`.
genClosure_ClassDeletePropertyFunction :: MonadIO m => ClassDeletePropertyFunction -> m (GClosure C_ClassDeletePropertyFunction)
genClosure_ClassDeletePropertyFunction :: ClassHasPropertyFunction -> m (GClosure C_ClassHasPropertyFunction)
genClosure_ClassDeletePropertyFunction ClassHasPropertyFunction
cb = IO (GClosure C_ClassHasPropertyFunction)
-> m (GClosure C_ClassHasPropertyFunction)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ClassHasPropertyFunction)
 -> m (GClosure C_ClassHasPropertyFunction))
-> IO (GClosure C_ClassHasPropertyFunction)
-> m (GClosure C_ClassHasPropertyFunction)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ClassHasPropertyFunction
cb' = Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
-> ClassHasPropertyFunction -> C_ClassHasPropertyFunction
wrap_ClassDeletePropertyFunction Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
forall a. Maybe a
Nothing ClassHasPropertyFunction
cb
    C_ClassHasPropertyFunction
-> IO (FunPtr C_ClassHasPropertyFunction)
mk_ClassDeletePropertyFunction C_ClassHasPropertyFunction
cb' IO (FunPtr C_ClassHasPropertyFunction)
-> (FunPtr C_ClassHasPropertyFunction
    -> IO (GClosure C_ClassHasPropertyFunction))
-> IO (GClosure C_ClassHasPropertyFunction)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ClassHasPropertyFunction
-> IO (GClosure C_ClassHasPropertyFunction)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ClassDeletePropertyFunction` into a `C_ClassDeletePropertyFunction`.
wrap_ClassDeletePropertyFunction ::
    Maybe (Ptr (FunPtr C_ClassDeletePropertyFunction)) ->
    ClassDeletePropertyFunction ->
    C_ClassDeletePropertyFunction
wrap_ClassDeletePropertyFunction :: Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
-> ClassHasPropertyFunction -> C_ClassHasPropertyFunction
wrap_ClassDeletePropertyFunction Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
funptrptr ClassHasPropertyFunction
_cb Ptr Class
jscClass Ptr Context
context Ptr ()
instance_ CString
name = do
    Class
jscClass' <- ((ManagedPtr Class -> Class) -> Ptr Class -> IO Class
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Class -> Class
JavaScriptCore.Class.Class) Ptr Class
jscClass
    Context
context' <- ((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
context
    Text
name' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
name
    Bool
result <- ClassHasPropertyFunction
_cb  Class
jscClass' Context
context' Ptr ()
instance_ Text
name'
    Maybe (Ptr (FunPtr C_ClassHasPropertyFunction)) -> IO ()
forall a. Maybe (Ptr (FunPtr a)) -> IO ()
maybeReleaseFunPtr Maybe (Ptr (FunPtr C_ClassHasPropertyFunction))
funptrptr
    let result' :: CInt
result' = (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
result
    CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'