{-# LANGUAGE TypeApplications #-}


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

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

module GI.JavaScriptCore.Objects.Context
    ( 

-- * Exported types
    Context(..)                             ,
    IsContext                               ,
    toContext                               ,
    noContext                               ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveContextMethod                    ,
#endif


-- ** checkSyntax #method:checkSyntax#

#if defined(ENABLE_OVERLOADING)
    ContextCheckSyntaxMethodInfo            ,
#endif
    contextCheckSyntax                      ,


-- ** clearException #method:clearException#

#if defined(ENABLE_OVERLOADING)
    ContextClearExceptionMethodInfo         ,
#endif
    contextClearException                   ,


-- ** evaluate #method:evaluate#

#if defined(ENABLE_OVERLOADING)
    ContextEvaluateMethodInfo               ,
#endif
    contextEvaluate                         ,


-- ** evaluateInObject #method:evaluateInObject#

#if defined(ENABLE_OVERLOADING)
    ContextEvaluateInObjectMethodInfo       ,
#endif
    contextEvaluateInObject                 ,


-- ** evaluateWithSourceUri #method:evaluateWithSourceUri#

#if defined(ENABLE_OVERLOADING)
    ContextEvaluateWithSourceUriMethodInfo  ,
#endif
    contextEvaluateWithSourceUri            ,


-- ** getCurrent #method:getCurrent#

    contextGetCurrent                       ,


-- ** getException #method:getException#

#if defined(ENABLE_OVERLOADING)
    ContextGetExceptionMethodInfo           ,
#endif
    contextGetException                     ,


-- ** getGlobalObject #method:getGlobalObject#

#if defined(ENABLE_OVERLOADING)
    ContextGetGlobalObjectMethodInfo        ,
#endif
    contextGetGlobalObject                  ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    ContextGetValueMethodInfo               ,
#endif
    contextGetValue                         ,


-- ** getVirtualMachine #method:getVirtualMachine#

#if defined(ENABLE_OVERLOADING)
    ContextGetVirtualMachineMethodInfo      ,
#endif
    contextGetVirtualMachine                ,


-- ** new #method:new#

    contextNew                              ,


-- ** newWithVirtualMachine #method:newWithVirtualMachine#

    contextNewWithVirtualMachine            ,


-- ** popExceptionHandler #method:popExceptionHandler#

#if defined(ENABLE_OVERLOADING)
    ContextPopExceptionHandlerMethodInfo    ,
#endif
    contextPopExceptionHandler              ,


-- ** pushExceptionHandler #method:pushExceptionHandler#

#if defined(ENABLE_OVERLOADING)
    ContextPushExceptionHandlerMethodInfo   ,
#endif
    contextPushExceptionHandler             ,


-- ** registerClass #method:registerClass#

#if defined(ENABLE_OVERLOADING)
    ContextRegisterClassMethodInfo          ,
#endif
    contextRegisterClass                    ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    ContextSetValueMethodInfo               ,
#endif
    contextSetValue                         ,


-- ** throw #method:throw#

#if defined(ENABLE_OVERLOADING)
    ContextThrowMethodInfo                  ,
#endif
    contextThrow                            ,


-- ** throwException #method:throwException#

#if defined(ENABLE_OVERLOADING)
    ContextThrowExceptionMethodInfo         ,
#endif
    contextThrowException                   ,


-- ** throwWithName #method:throwWithName#

#if defined(ENABLE_OVERLOADING)
    ContextThrowWithNameMethodInfo          ,
#endif
    contextThrowWithName                    ,




 -- * Properties
-- ** virtualMachine #attr:virtualMachine#
-- | The t'GI.JavaScriptCore.Objects.VirtualMachine.VirtualMachine' in which the context was created.

#if defined(ENABLE_OVERLOADING)
    ContextVirtualMachinePropertyInfo       ,
#endif
    constructContextVirtualMachine          ,
#if defined(ENABLE_OVERLOADING)
    contextVirtualMachine                   ,
#endif
    getContextVirtualMachine                ,




    ) 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.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 Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.JavaScriptCore.Callbacks as JavaScriptCore.Callbacks
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.Exception as JavaScriptCore.Exception
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.Value as JavaScriptCore.Value
import {-# SOURCE #-} qualified GI.JavaScriptCore.Objects.VirtualMachine as JavaScriptCore.VirtualMachine
import {-# SOURCE #-} qualified GI.JavaScriptCore.Structs.ClassVTable as JavaScriptCore.ClassVTable

-- | Memory-managed wrapper type.
newtype Context = Context (ManagedPtr Context)
    deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)
foreign import ccall "jsc_context_get_type"
    c_jsc_context_get_type :: IO GType

instance GObject Context where
    gobjectType :: IO GType
gobjectType = IO GType
c_jsc_context_get_type
    

-- | Convert 'Context' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Context where
    toGValue :: Context -> IO GValue
toGValue o :: Context
o = do
        GType
gtype <- IO GType
c_jsc_context_get_type
        Context -> (Ptr Context -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Context
o (GType
-> (GValue -> Ptr Context -> IO ()) -> Ptr Context -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Context -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Context
fromGValue gv :: GValue
gv = do
        Ptr Context
ptr <- GValue -> IO (Ptr Context)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Context)
        (ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Context -> Context
Context Ptr Context
ptr
        
    

-- | Type class for types which can be safely cast to `Context`, for instance with `toContext`.
class (GObject o, O.IsDescendantOf Context o) => IsContext o
instance (GObject o, O.IsDescendantOf Context o) => IsContext o

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

-- | Cast to `Context`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toContext :: (MonadIO m, IsContext o) => o -> m Context
toContext :: o -> m Context
toContext = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> (o -> IO Context) -> o -> m Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Context -> Context) -> o -> IO Context
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Context -> Context
Context

-- | A convenience alias for `Nothing` :: `Maybe` `Context`.
noContext :: Maybe Context
noContext :: Maybe Context
noContext = Maybe Context
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContextMethod "checkSyntax" o = ContextCheckSyntaxMethodInfo
    ResolveContextMethod "clearException" o = ContextClearExceptionMethodInfo
    ResolveContextMethod "evaluate" o = ContextEvaluateMethodInfo
    ResolveContextMethod "evaluateInObject" o = ContextEvaluateInObjectMethodInfo
    ResolveContextMethod "evaluateWithSourceUri" o = ContextEvaluateWithSourceUriMethodInfo
    ResolveContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContextMethod "popExceptionHandler" o = ContextPopExceptionHandlerMethodInfo
    ResolveContextMethod "pushExceptionHandler" o = ContextPushExceptionHandlerMethodInfo
    ResolveContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContextMethod "registerClass" o = ContextRegisterClassMethodInfo
    ResolveContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContextMethod "throw" o = ContextThrowMethodInfo
    ResolveContextMethod "throwException" o = ContextThrowExceptionMethodInfo
    ResolveContextMethod "throwWithName" o = ContextThrowWithNameMethodInfo
    ResolveContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContextMethod "getException" o = ContextGetExceptionMethodInfo
    ResolveContextMethod "getGlobalObject" o = ContextGetGlobalObjectMethodInfo
    ResolveContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContextMethod "getValue" o = ContextGetValueMethodInfo
    ResolveContextMethod "getVirtualMachine" o = ContextGetVirtualMachineMethodInfo
    ResolveContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContextMethod "setValue" o = ContextSetValueMethodInfo
    ResolveContextMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveContextMethod t Context, O.MethodInfo info Context p) => OL.IsLabel t (Context -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

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

-- | Construct a `GValueConstruct` with valid value for the “@virtual-machine@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructContextVirtualMachine :: (IsContext o, JavaScriptCore.VirtualMachine.IsVirtualMachine a) => a -> IO (GValueConstruct o)
constructContextVirtualMachine :: a -> IO (GValueConstruct o)
constructContextVirtualMachine val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "virtual-machine" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data ContextVirtualMachinePropertyInfo
instance AttrInfo ContextVirtualMachinePropertyInfo where
    type AttrAllowedOps ContextVirtualMachinePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ContextVirtualMachinePropertyInfo = IsContext
    type AttrSetTypeConstraint ContextVirtualMachinePropertyInfo = JavaScriptCore.VirtualMachine.IsVirtualMachine
    type AttrTransferTypeConstraint ContextVirtualMachinePropertyInfo = JavaScriptCore.VirtualMachine.IsVirtualMachine
    type AttrTransferType ContextVirtualMachinePropertyInfo = JavaScriptCore.VirtualMachine.VirtualMachine
    type AttrGetType ContextVirtualMachinePropertyInfo = JavaScriptCore.VirtualMachine.VirtualMachine
    type AttrLabel ContextVirtualMachinePropertyInfo = "virtual-machine"
    type AttrOrigin ContextVirtualMachinePropertyInfo = Context
    attrGet = getContextVirtualMachine
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo JavaScriptCore.VirtualMachine.VirtualMachine v
    attrConstruct = constructContextVirtualMachine
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Context
type instance O.AttributeList Context = ContextAttributeList
type ContextAttributeList = ('[ '("virtualMachine", ContextVirtualMachinePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
contextVirtualMachine :: AttrLabelProxy "virtualMachine"
contextVirtualMachine = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "jsc_context_new" jsc_context_new :: 
    IO (Ptr Context)

-- | Create a new t'GI.JavaScriptCore.Objects.Context.Context'. The context is created in a new t'GI.JavaScriptCore.Objects.VirtualMachine.VirtualMachine'.
-- Use 'GI.JavaScriptCore.Objects.Context.contextNewWithVirtualMachine' to create a new t'GI.JavaScriptCore.Objects.Context.Context' in an
-- existing t'GI.JavaScriptCore.Objects.VirtualMachine.VirtualMachine'.
contextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Context
    -- ^ __Returns:__ the newly created t'GI.JavaScriptCore.Objects.Context.Context'.
contextNew :: m Context
contextNew  = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
result <- IO (Ptr Context)
jsc_context_new
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextNew" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Context -> Context
Context) Ptr Context
result
    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "jsc_context_new_with_virtual_machine" jsc_context_new_with_virtual_machine :: 
    Ptr JavaScriptCore.VirtualMachine.VirtualMachine -> -- vm : TInterface (Name {namespace = "JavaScriptCore", name = "VirtualMachine"})
    IO (Ptr Context)

-- | Create a new t'GI.JavaScriptCore.Objects.Context.Context' in /@virtualMachine@/.
contextNewWithVirtualMachine ::
    (B.CallStack.HasCallStack, MonadIO m, JavaScriptCore.VirtualMachine.IsVirtualMachine a) =>
    a
    -- ^ /@vm@/: a t'GI.JavaScriptCore.Objects.VirtualMachine.VirtualMachine'
    -> m Context
    -- ^ __Returns:__ the newly created t'GI.JavaScriptCore.Objects.Context.Context'.
contextNewWithVirtualMachine :: a -> m Context
contextNewWithVirtualMachine vm :: a
vm = IO Context -> m Context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    Ptr VirtualMachine
vm' <- a -> IO (Ptr VirtualMachine)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
vm
    Ptr Context
result <- Ptr VirtualMachine -> IO (Ptr Context)
jsc_context_new_with_virtual_machine Ptr VirtualMachine
vm'
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextNewWithVirtualMachine" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Context -> Context
Context) Ptr Context
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
vm
    Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Context::check_syntax
-- method type : OrdinaryMethod
-- 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 = "code"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JavaScript script to check"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "length of @code, or -1 if @code is a nul-terminated string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "CheckSyntaxMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCCheckSyntaxMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source URI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_number"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the starting line number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "exception"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "Exception" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "return location for a #JSCException, or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "JavaScriptCore" , name = "CheckSyntaxResult" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_check_syntax" jsc_context_check_syntax :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- code : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    CUInt ->                                -- mode : TInterface (Name {namespace = "JavaScriptCore", name = "CheckSyntaxMode"})
    CString ->                              -- uri : TBasicType TUTF8
    Word32 ->                               -- line_number : TBasicType TUInt
    Ptr (Ptr JavaScriptCore.Exception.Exception) -> -- exception : TInterface (Name {namespace = "JavaScriptCore", name = "Exception"})
    IO CUInt

-- | Check the given /@code@/ in /@context@/ for syntax errors. The /@lineNumber@/ is the starting line number in /@uri@/;
-- the value is one-based so the first line is 1. /@uri@/ and /@lineNumber@/ are only used to fill the /@exception@/.
-- In case of errors /@exception@/ will be set to a new t'GI.JavaScriptCore.Objects.Exception.Exception' with the details. You can pass 'P.Nothing' to
-- /@exception@/ to ignore the error details.
contextCheckSyntax ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@code@/: a JavaScript script to check
    -> Int64
    -- ^ /@length@/: length of /@code@/, or -1 if /@code@/ is a nul-terminated string
    -> JavaScriptCore.Enums.CheckSyntaxMode
    -- ^ /@mode@/: a t'GI.JavaScriptCore.Enums.CheckSyntaxMode'
    -> T.Text
    -- ^ /@uri@/: the source URI
    -> Word32
    -- ^ /@lineNumber@/: the starting line number
    -> m ((JavaScriptCore.Enums.CheckSyntaxResult, JavaScriptCore.Exception.Exception))
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Enums.CheckSyntaxResult'
contextCheckSyntax :: a
-> Text
-> Int64
-> CheckSyntaxMode
-> Text
-> Word32
-> m (CheckSyntaxResult, Exception)
contextCheckSyntax context :: a
context code :: Text
code length_ :: Int64
length_ mode :: CheckSyntaxMode
mode uri :: Text
uri lineNumber :: Word32
lineNumber = IO (CheckSyntaxResult, Exception)
-> m (CheckSyntaxResult, Exception)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CheckSyntaxResult, Exception)
 -> m (CheckSyntaxResult, Exception))
-> IO (CheckSyntaxResult, Exception)
-> m (CheckSyntaxResult, Exception)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
code' <- Text -> IO CString
textToCString Text
code
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (CheckSyntaxMode -> Int) -> CheckSyntaxMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CheckSyntaxMode -> Int
forall a. Enum a => a -> Int
fromEnum) CheckSyntaxMode
mode
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr (Ptr Exception)
exception <- IO (Ptr (Ptr Exception))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr JavaScriptCore.Exception.Exception))
    CUInt
result <- Ptr Context
-> CString
-> Int64
-> CUInt
-> CString
-> Word32
-> Ptr (Ptr Exception)
-> IO CUInt
jsc_context_check_syntax Ptr Context
context' CString
code' Int64
length_ CUInt
mode' CString
uri' Word32
lineNumber Ptr (Ptr Exception)
exception
    let result' :: CheckSyntaxResult
result' = (Int -> CheckSyntaxResult
forall a. Enum a => Int -> a
toEnum (Int -> CheckSyntaxResult)
-> (CUInt -> Int) -> CUInt -> CheckSyntaxResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Ptr Exception
exception' <- Ptr (Ptr Exception) -> IO (Ptr Exception)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Exception)
exception
    Exception
exception'' <- ((ManagedPtr Exception -> Exception)
-> Ptr Exception -> IO Exception
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Exception -> Exception
JavaScriptCore.Exception.Exception) Ptr Exception
exception'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
code'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    Ptr (Ptr Exception) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Exception)
exception
    (CheckSyntaxResult, Exception) -> IO (CheckSyntaxResult, Exception)
forall (m :: * -> *) a. Monad m => a -> m a
return (CheckSyntaxResult
result', Exception
exception'')

#if defined(ENABLE_OVERLOADING)
data ContextCheckSyntaxMethodInfo
instance (signature ~ (T.Text -> Int64 -> JavaScriptCore.Enums.CheckSyntaxMode -> T.Text -> Word32 -> m ((JavaScriptCore.Enums.CheckSyntaxResult, JavaScriptCore.Exception.Exception))), MonadIO m, IsContext a) => O.MethodInfo ContextCheckSyntaxMethodInfo a signature where
    overloadedMethod = contextCheckSyntax

#endif

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

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

-- | Clear the uncaught exception in /@context@/ if any.
contextClearException ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m ()
contextClearException :: a -> m ()
contextClearException context :: a
context = 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 Context -> IO ()
jsc_context_clear_exception Ptr Context
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextClearExceptionMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContext a) => O.MethodInfo ContextClearExceptionMethodInfo a signature where
    overloadedMethod = contextClearException

#endif

-- method Context::evaluate
-- method type : OrdinaryMethod
-- 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 = "code"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JavaScript script to evaluate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "length of @code, or -1 if @code is a nul-terminated string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_evaluate" jsc_context_evaluate :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- code : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    IO (Ptr JavaScriptCore.Value.Value)

-- | Evaluate /@code@/ in /@context@/.
contextEvaluate ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@code@/: a JavaScript script to evaluate
    -> Int64
    -- ^ /@length@/: length of /@code@/, or -1 if /@code@/ is a nul-terminated string
    -> m JavaScriptCore.Value.Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' representing the last value generated by the script.
contextEvaluate :: a -> Text -> Int64 -> m Value
contextEvaluate context :: a
context code :: Text
code length_ :: Int64
length_ = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
code' <- Text -> IO CString
textToCString Text
code
    Ptr Value
result <- Ptr Context -> CString -> Int64 -> IO (Ptr Value)
jsc_context_evaluate Ptr Context
context' CString
code' Int64
length_
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextEvaluate" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
code'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ContextEvaluateMethodInfo
instance (signature ~ (T.Text -> Int64 -> m JavaScriptCore.Value.Value), MonadIO m, IsContext a) => O.MethodInfo ContextEvaluateMethodInfo a signature where
    overloadedMethod = contextEvaluate

#endif

-- method Context::evaluate_in_object
-- method type : OrdinaryMethod
-- 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 = "code"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JavaScript script to evaluate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "length of @code, or -1 if @code is a nul-terminated string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_instance"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an object instance" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass or %NULL to use the default"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source URI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_number"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the starting line number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Value" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a #JSCValue."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_evaluate_in_object" jsc_context_evaluate_in_object :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- code : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    Ptr () ->                               -- object_instance : TBasicType TPtr
    Ptr JavaScriptCore.Class.Class ->       -- object_class : TInterface (Name {namespace = "JavaScriptCore", name = "Class"})
    CString ->                              -- uri : TBasicType TUTF8
    Word32 ->                               -- line_number : TBasicType TUInt
    Ptr (Ptr JavaScriptCore.Value.Value) -> -- object : TInterface (Name {namespace = "JavaScriptCore", name = "Value"})
    IO (Ptr JavaScriptCore.Value.Value)

-- | Evaluate /@code@/ and create an new object where symbols defined in /@code@/ will be added as properties,
-- instead of being added to /@context@/ global object. The new object is returned as /@object@/ parameter.
-- Similar to how 'GI.JavaScriptCore.Objects.Value.valueNewObject' works, if /@objectInstance@/ is not 'P.Nothing' /@objectClass@/ must be provided too.
-- The /@lineNumber@/ is the starting line number in /@uri@/; the value is one-based so the first line is 1.
-- /@uri@/ and /@lineNumber@/ will be shown in exceptions and they don\'t affect the behavior of the script.
contextEvaluateInObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a, JavaScriptCore.Class.IsClass b) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@code@/: a JavaScript script to evaluate
    -> Int64
    -- ^ /@length@/: length of /@code@/, or -1 if /@code@/ is a nul-terminated string
    -> Ptr ()
    -- ^ /@objectInstance@/: an object instance
    -> Maybe (b)
    -- ^ /@objectClass@/: a t'GI.JavaScriptCore.Objects.Class.Class' or 'P.Nothing' to use the default
    -> T.Text
    -- ^ /@uri@/: the source URI
    -> Word32
    -- ^ /@lineNumber@/: the starting line number
    -> m ((JavaScriptCore.Value.Value, JavaScriptCore.Value.Value))
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' representing the last value generated by the script.
contextEvaluateInObject :: a
-> Text
-> Int64
-> Ptr ()
-> Maybe b
-> Text
-> Word32
-> m (Value, Value)
contextEvaluateInObject context :: a
context code :: Text
code length_ :: Int64
length_ objectInstance :: Ptr ()
objectInstance objectClass :: Maybe b
objectClass uri :: Text
uri lineNumber :: Word32
lineNumber = IO (Value, Value) -> m (Value, Value)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Value, Value) -> m (Value, Value))
-> IO (Value, Value) -> m (Value, Value)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
code' <- Text -> IO CString
textToCString Text
code
    Ptr Class
maybeObjectClass <- case Maybe b
objectClass of
        Nothing -> Ptr Class -> IO (Ptr Class)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Class
forall a. Ptr a
nullPtr
        Just jObjectClass :: b
jObjectClass -> do
            Ptr Class
jObjectClass' <- b -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jObjectClass
            Ptr Class -> IO (Ptr Class)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Class
jObjectClass'
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr (Ptr Value)
object <- IO (Ptr (Ptr Value))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr JavaScriptCore.Value.Value))
    Ptr Value
result <- Ptr Context
-> CString
-> Int64
-> Ptr ()
-> Ptr Class
-> CString
-> Word32
-> Ptr (Ptr Value)
-> IO (Ptr Value)
jsc_context_evaluate_in_object Ptr Context
context' CString
code' Int64
length_ Ptr ()
objectInstance Ptr Class
maybeObjectClass CString
uri' Word32
lineNumber Ptr (Ptr Value)
object
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextEvaluateInObject" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
result
    Ptr Value
object' <- Ptr (Ptr Value) -> IO (Ptr Value)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Value)
object
    Value
object'' <- ((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
object'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
objectClass b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
code'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    Ptr (Ptr Value) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Value)
object
    (Value, Value) -> IO (Value, Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
result', Value
object'')

#if defined(ENABLE_OVERLOADING)
data ContextEvaluateInObjectMethodInfo
instance (signature ~ (T.Text -> Int64 -> Ptr () -> Maybe (b) -> T.Text -> Word32 -> m ((JavaScriptCore.Value.Value, JavaScriptCore.Value.Value))), MonadIO m, IsContext a, JavaScriptCore.Class.IsClass b) => O.MethodInfo ContextEvaluateInObjectMethodInfo a signature where
    overloadedMethod = contextEvaluateInObject

#endif

-- method Context::evaluate_with_source_uri
-- method type : OrdinaryMethod
-- 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 = "code"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a JavaScript script to evaluate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "length of @code, or -1 if @code is a nul-terminated string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the source URI" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_number"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the starting line number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_evaluate_with_source_uri" jsc_context_evaluate_with_source_uri :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- code : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    CString ->                              -- uri : TBasicType TUTF8
    Word32 ->                               -- line_number : TBasicType TUInt
    IO (Ptr JavaScriptCore.Value.Value)

-- | Evaluate /@code@/ in /@context@/ using /@uri@/ as the source URI. The /@lineNumber@/ is the starting line number
-- in /@uri@/; the value is one-based so the first line is 1. /@uri@/ and /@lineNumber@/ will be shown in exceptions and
-- they don\'t affect the behavior of the script.
contextEvaluateWithSourceUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@code@/: a JavaScript script to evaluate
    -> Int64
    -- ^ /@length@/: length of /@code@/, or -1 if /@code@/ is a nul-terminated string
    -> T.Text
    -- ^ /@uri@/: the source URI
    -> Word32
    -- ^ /@lineNumber@/: the starting line number
    -> m JavaScriptCore.Value.Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value' representing the last value generated by the script.
contextEvaluateWithSourceUri :: a -> Text -> Int64 -> Text -> Word32 -> m Value
contextEvaluateWithSourceUri context :: a
context code :: Text
code length_ :: Int64
length_ uri :: Text
uri lineNumber :: Word32
lineNumber = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
code' <- Text -> IO CString
textToCString Text
code
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr Value
result <- Ptr Context
-> CString -> Int64 -> CString -> Word32 -> IO (Ptr Value)
jsc_context_evaluate_with_source_uri Ptr Context
context' CString
code' Int64
length_ CString
uri' Word32
lineNumber
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextEvaluateWithSourceUri" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
code'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ContextEvaluateWithSourceUriMethodInfo
instance (signature ~ (T.Text -> Int64 -> T.Text -> Word32 -> m JavaScriptCore.Value.Value), MonadIO m, IsContext a) => O.MethodInfo ContextEvaluateWithSourceUriMethodInfo a signature where
    overloadedMethod = contextEvaluateWithSourceUri

#endif

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

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

-- | Get the last unhandled exception thrown in /@context@/ by API functions calls.
contextGetException ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m (Maybe JavaScriptCore.Exception.Exception)
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Exception.Exception' or 'P.Nothing' if there isn\'t any
    --    unhandled exception in the t'GI.JavaScriptCore.Objects.Context.Context'.
contextGetException :: a -> m (Maybe Exception)
contextGetException context :: a
context = IO (Maybe Exception) -> m (Maybe Exception)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Exception) -> m (Maybe Exception))
-> IO (Maybe Exception) -> m (Maybe Exception)
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
result <- Ptr Context -> IO (Ptr Exception)
jsc_context_get_exception Ptr Context
context'
    Maybe Exception
maybeResult <- Ptr Exception
-> (Ptr Exception -> IO Exception) -> IO (Maybe Exception)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Exception
result ((Ptr Exception -> IO Exception) -> IO (Maybe Exception))
-> (Ptr Exception -> IO Exception) -> IO (Maybe Exception)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Exception
result' -> do
        Exception
result'' <- ((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
result'
        Exception -> IO Exception
forall (m :: * -> *) a. Monad m => a -> m a
return Exception
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe Exception -> IO (Maybe Exception)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Exception
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextGetExceptionMethodInfo
instance (signature ~ (m (Maybe JavaScriptCore.Exception.Exception)), MonadIO m, IsContext a) => O.MethodInfo ContextGetExceptionMethodInfo a signature where
    overloadedMethod = contextGetException

#endif

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

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

-- | Get a t'GI.JavaScriptCore.Objects.Value.Value' referencing the /@context@/ global object
contextGetGlobalObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m JavaScriptCore.Value.Value
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Value.Value'
contextGetGlobalObject :: a -> m Value
contextGetGlobalObject context :: a
context = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr Value
result <- Ptr Context -> IO (Ptr Value)
jsc_context_get_global_object Ptr Context
context'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextGetGlobalObject" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Value -> Value
JavaScriptCore.Value.Value) Ptr Value
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetGlobalObjectMethodInfo
instance (signature ~ (m JavaScriptCore.Value.Value), MonadIO m, IsContext a) => O.MethodInfo ContextGetGlobalObjectMethodInfo a signature where
    overloadedMethod = contextGetGlobalObject

#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data ContextGetValueMethodInfo
instance (signature ~ (T.Text -> m JavaScriptCore.Value.Value), MonadIO m, IsContext a) => O.MethodInfo ContextGetValueMethodInfo a signature where
    overloadedMethod = contextGetValue

#endif

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

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

-- | Get the t'GI.JavaScriptCore.Objects.VirtualMachine.VirtualMachine' where /@context@/ was created.
contextGetVirtualMachine ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m JavaScriptCore.VirtualMachine.VirtualMachine
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.VirtualMachine.VirtualMachine' where the t'GI.JavaScriptCore.Objects.Context.Context' was created.
contextGetVirtualMachine :: a -> m VirtualMachine
contextGetVirtualMachine context :: a
context = IO VirtualMachine -> m VirtualMachine
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VirtualMachine -> m VirtualMachine)
-> IO VirtualMachine -> m VirtualMachine
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 VirtualMachine
result <- Ptr Context -> IO (Ptr VirtualMachine)
jsc_context_get_virtual_machine Ptr Context
context'
    Text -> Ptr VirtualMachine -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextGetVirtualMachine" Ptr VirtualMachine
result
    VirtualMachine
result' <- ((ManagedPtr VirtualMachine -> VirtualMachine)
-> Ptr VirtualMachine -> IO VirtualMachine
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr VirtualMachine -> VirtualMachine
JavaScriptCore.VirtualMachine.VirtualMachine) Ptr VirtualMachine
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    VirtualMachine -> IO VirtualMachine
forall (m :: * -> *) a. Monad m => a -> m a
return VirtualMachine
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetVirtualMachineMethodInfo
instance (signature ~ (m JavaScriptCore.VirtualMachine.VirtualMachine), MonadIO m, IsContext a) => O.MethodInfo ContextGetVirtualMachineMethodInfo a signature where
    overloadedMethod = contextGetVirtualMachine

#endif

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

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

-- | Remove the last t'GI.JavaScriptCore.Callbacks.ExceptionHandler' previously pushed to /@context@/ with
-- 'GI.JavaScriptCore.Objects.Context.contextPushExceptionHandler'.
contextPopExceptionHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> m ()
contextPopExceptionHandler :: a -> m ()
contextPopExceptionHandler context :: a
context = 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 Context -> IO ()
jsc_context_pop_exception_handler Ptr Context
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextPopExceptionHandlerMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContext a) => O.MethodInfo ContextPopExceptionHandlerMethodInfo a signature where
    overloadedMethod = contextPopExceptionHandler

#endif

-- method Context::push_exception_handler
-- method type : OrdinaryMethod
-- 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 = "handler"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "ExceptionHandler" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCExceptionHandler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @handler"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destroy notifier for @user_data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_push_exception_handler" jsc_context_push_exception_handler :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    FunPtr JavaScriptCore.Callbacks.C_ExceptionHandler -> -- handler : TInterface (Name {namespace = "JavaScriptCore", name = "ExceptionHandler"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Push an exception handler in /@context@/. Whenever a JavaScript exception happens in
-- the t'GI.JavaScriptCore.Objects.Context.Context', the given /@handler@/ will be called. The default t'GI.JavaScriptCore.Callbacks.ExceptionHandler'
-- simply calls 'GI.JavaScriptCore.Objects.Context.contextThrowException' to throw the exception to the t'GI.JavaScriptCore.Objects.Context.Context'.
-- If you don\'t want to catch the exception, but only get notified about it, call
-- 'GI.JavaScriptCore.Objects.Context.contextThrowException' in /@handler@/ like the default one does.
-- The last exception handler pushed is the only one used by the t'GI.JavaScriptCore.Objects.Context.Context', use
-- 'GI.JavaScriptCore.Objects.Context.contextPopExceptionHandler' to remove it and set the previous one. When /@handler@/
-- is removed from the context, /@destroyNotify@/ i called with /@userData@/ as parameter.
contextPushExceptionHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> JavaScriptCore.Callbacks.ExceptionHandler
    -- ^ /@handler@/: a t'GI.JavaScriptCore.Callbacks.ExceptionHandler'
    -> m ()
contextPushExceptionHandler :: a -> ExceptionHandler -> m ()
contextPushExceptionHandler context :: a
context handler :: ExceptionHandler
handler = 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
    FunPtr C_ExceptionHandler
handler' <- C_ExceptionHandler -> IO (FunPtr C_ExceptionHandler)
JavaScriptCore.Callbacks.mk_ExceptionHandler (Maybe (Ptr (FunPtr C_ExceptionHandler))
-> ExceptionHandler_WithClosures -> C_ExceptionHandler
JavaScriptCore.Callbacks.wrap_ExceptionHandler Maybe (Ptr (FunPtr C_ExceptionHandler))
forall a. Maybe a
Nothing (ExceptionHandler -> ExceptionHandler_WithClosures
JavaScriptCore.Callbacks.drop_closures_ExceptionHandler ExceptionHandler
handler))
    let userData :: Ptr ()
userData = FunPtr C_ExceptionHandler -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ExceptionHandler
handler'
    let destroyNotify :: FunPtr (Ptr a -> IO ())
destroyNotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
safeFreeFunPtrPtr
    Ptr Context
-> FunPtr C_ExceptionHandler
-> Ptr ()
-> FunPtr C_DestroyNotify
-> IO ()
jsc_context_push_exception_handler Ptr Context
context' FunPtr C_ExceptionHandler
handler' Ptr ()
userData FunPtr C_DestroyNotify
forall a. FunPtr (Ptr a -> IO ())
destroyNotify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextPushExceptionHandlerMethodInfo
instance (signature ~ (JavaScriptCore.Callbacks.ExceptionHandler -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextPushExceptionHandlerMethodInfo a signature where
    overloadedMethod = contextPushExceptionHandler

#endif

-- method Context::register_class
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCContext" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the class name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent_class"
--           , argType =
--               TInterface Name { namespace = "JavaScriptCore" , name = "Class" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #JSCClass or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "vtable"
--           , argType =
--               TInterface
--                 Name { namespace = "JavaScriptCore" , name = "ClassVTable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an optional #JSCClassVTable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy_notify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a destroy notifier for class instances"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "JavaScriptCore" , name = "Class" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_register_class" jsc_context_register_class :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr JavaScriptCore.Class.Class ->       -- parent_class : TInterface (Name {namespace = "JavaScriptCore", name = "Class"})
    Ptr JavaScriptCore.ClassVTable.ClassVTable -> -- vtable : TInterface (Name {namespace = "JavaScriptCore", name = "ClassVTable"})
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy_notify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr JavaScriptCore.Class.Class)

-- | Register a custom class in /@context@/ using the given /@name@/. If the new class inherits from
-- another t'GI.JavaScriptCore.Objects.Class.Class', the parent should be passed as /@parentClass@/, otherwise 'P.Nothing' should be
-- used. The optional /@vtable@/ parameter allows to provide a custom implementation for handling
-- the class, for example, to handle external properties not added to the prototype.
-- When an instance of the t'GI.JavaScriptCore.Objects.Class.Class' is cleared in the context, /@destroyNotify@/ is called with
-- the instance as parameter.
contextRegisterClass ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a, JavaScriptCore.Class.IsClass b) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@name@/: the class name
    -> Maybe (b)
    -- ^ /@parentClass@/: a t'GI.JavaScriptCore.Objects.Class.Class' or 'P.Nothing'
    -> Maybe (JavaScriptCore.ClassVTable.ClassVTable)
    -- ^ /@vtable@/: an optional t'GI.JavaScriptCore.Structs.ClassVTable.ClassVTable' or 'P.Nothing'
    -> Maybe (GLib.Callbacks.DestroyNotify)
    -- ^ /@destroyNotify@/: a destroy notifier for class instances
    -> m JavaScriptCore.Class.Class
    -- ^ __Returns:__ a t'GI.JavaScriptCore.Objects.Class.Class'
contextRegisterClass :: a
-> Text
-> Maybe b
-> Maybe ClassVTable
-> Maybe C_DestroyNotify
-> m Class
contextRegisterClass context :: a
context name :: Text
name parentClass :: Maybe b
parentClass vtable :: Maybe ClassVTable
vtable destroyNotify :: Maybe C_DestroyNotify
destroyNotify = IO Class -> m Class
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Class -> m Class) -> IO Class -> m Class
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Class
maybeParentClass <- case Maybe b
parentClass of
        Nothing -> Ptr Class -> IO (Ptr Class)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Class
forall a. Ptr a
nullPtr
        Just jParentClass :: b
jParentClass -> do
            Ptr Class
jParentClass' <- b -> IO (Ptr Class)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParentClass
            Ptr Class -> IO (Ptr Class)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Class
jParentClass'
    Ptr ClassVTable
maybeVtable <- case Maybe ClassVTable
vtable of
        Nothing -> Ptr ClassVTable -> IO (Ptr ClassVTable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ClassVTable
forall a. Ptr a
nullPtr
        Just jVtable :: ClassVTable
jVtable -> do
            Ptr ClassVTable
jVtable' <- ClassVTable -> IO (Ptr ClassVTable)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ClassVTable
jVtable
            Ptr ClassVTable -> IO (Ptr ClassVTable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ClassVTable
jVtable'
    FunPtr C_DestroyNotify
maybeDestroyNotify <- case Maybe C_DestroyNotify
destroyNotify of
        Nothing -> FunPtr C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_DestroyNotify
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jDestroyNotify :: C_DestroyNotify
jDestroyNotify -> do
            Ptr (FunPtr C_DestroyNotify)
ptrdestroyNotify <- IO (Ptr (FunPtr C_DestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
            FunPtr C_DestroyNotify
jDestroyNotify' <- C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr C_DestroyNotify))
-> C_DestroyNotify -> C_DestroyNotify
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr C_DestroyNotify)
-> Maybe (Ptr (FunPtr C_DestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr C_DestroyNotify)
ptrdestroyNotify) C_DestroyNotify
jDestroyNotify)
            Ptr (FunPtr C_DestroyNotify) -> FunPtr C_DestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_DestroyNotify)
ptrdestroyNotify FunPtr C_DestroyNotify
jDestroyNotify'
            FunPtr C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_DestroyNotify
jDestroyNotify'
    Ptr Class
result <- Ptr Context
-> CString
-> Ptr Class
-> Ptr ClassVTable
-> FunPtr C_DestroyNotify
-> IO (Ptr Class)
jsc_context_register_class Ptr Context
context' CString
name' Ptr Class
maybeParentClass Ptr ClassVTable
maybeVtable FunPtr C_DestroyNotify
maybeDestroyNotify
    Text -> Ptr Class -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextRegisterClass" Ptr Class
result
    Class
result' <- ((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
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parentClass b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe ClassVTable -> (ClassVTable -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ClassVTable
vtable ClassVTable -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Class -> IO Class
forall (m :: * -> *) a. Monad m => a -> m a
return Class
result'

#if defined(ENABLE_OVERLOADING)
data ContextRegisterClassMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (JavaScriptCore.ClassVTable.ClassVTable) -> Maybe (GLib.Callbacks.DestroyNotify) -> m JavaScriptCore.Class.Class), MonadIO m, IsContext a, JavaScriptCore.Class.IsClass b) => O.MethodInfo ContextRegisterClassMethodInfo a signature where
    overloadedMethod = contextRegisterClass

#endif

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

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

-- | Set a property of /@context@/ global object with /@name@/ and /@value@/.
contextSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a, JavaScriptCore.Value.IsValue b) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@name@/: the value name
    -> b
    -- ^ /@value@/: a t'GI.JavaScriptCore.Objects.Value.Value'
    -> m ()
contextSetValue :: a -> Text -> b -> m ()
contextSetValue context :: a
context name :: Text
name value :: b
value = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- a -> IO (Ptr Context)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Value
value' <- b -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
value
    Ptr Context -> CString -> Ptr Value -> IO ()
jsc_context_set_value Ptr Context
context' CString
name' Ptr Value
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
value
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextSetValueMethodInfo
instance (signature ~ (T.Text -> b -> m ()), MonadIO m, IsContext a, JavaScriptCore.Value.IsValue b) => O.MethodInfo ContextSetValueMethodInfo a signature where
    overloadedMethod = contextSetValue

#endif

-- method Context::throw
-- method type : OrdinaryMethod
-- 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 = "error_message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an error message" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Throw an exception to /@context@/ using the given error message. The created t'GI.JavaScriptCore.Objects.Exception.Exception'
-- can be retrieved with 'GI.JavaScriptCore.Objects.Context.contextGetException'.
contextThrow ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@errorMessage@/: an error message
    -> m ()
contextThrow :: a -> Text -> m ()
contextThrow context :: a
context errorMessage :: Text
errorMessage = 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
    CString
errorMessage' <- Text -> IO CString
textToCString Text
errorMessage
    Ptr Context -> CString -> IO ()
jsc_context_throw Ptr Context
context' CString
errorMessage'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
errorMessage'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextThrowMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextThrowMethodInfo a signature where
    overloadedMethod = contextThrow

#endif

-- method Context::throw_exception
-- method type : OrdinaryMethod
-- 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
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Throw /@exception@/ to /@context@/.
contextThrowException ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a, JavaScriptCore.Exception.IsException b) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> b
    -- ^ /@exception@/: a t'GI.JavaScriptCore.Objects.Exception.Exception'
    -> m ()
contextThrowException :: a -> b -> m ()
contextThrowException context :: a
context exception :: b
exception = 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
    Ptr Context -> Ptr Exception -> IO ()
jsc_context_throw_exception Ptr Context
context' Ptr Exception
exception'
    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 ()

#if defined(ENABLE_OVERLOADING)
data ContextThrowExceptionMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContext a, JavaScriptCore.Exception.IsException b) => O.MethodInfo ContextThrowExceptionMethodInfo a signature where
    overloadedMethod = contextThrowException

#endif

-- method Context::throw_with_name
-- method type : OrdinaryMethod
-- 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 = "error_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the error name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "error_message"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an error message" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_throw_with_name" jsc_context_throw_with_name :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "JavaScriptCore", name = "Context"})
    CString ->                              -- error_name : TBasicType TUTF8
    CString ->                              -- error_message : TBasicType TUTF8
    IO ()

-- | Throw an exception to /@context@/ using the given error name and message. The created t'GI.JavaScriptCore.Objects.Exception.Exception'
-- can be retrieved with 'GI.JavaScriptCore.Objects.Context.contextGetException'.
contextThrowWithName ::
    (B.CallStack.HasCallStack, MonadIO m, IsContext a) =>
    a
    -- ^ /@context@/: a t'GI.JavaScriptCore.Objects.Context.Context'
    -> T.Text
    -- ^ /@errorName@/: the error name
    -> T.Text
    -- ^ /@errorMessage@/: an error message
    -> m ()
contextThrowWithName :: a -> Text -> Text -> m ()
contextThrowWithName context :: a
context errorName :: Text
errorName errorMessage :: Text
errorMessage = 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
    CString
errorName' <- Text -> IO CString
textToCString Text
errorName
    CString
errorMessage' <- Text -> IO CString
textToCString Text
errorMessage
    Ptr Context -> CString -> CString -> IO ()
jsc_context_throw_with_name Ptr Context
context' CString
errorName' CString
errorMessage'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
errorName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
errorMessage'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextThrowWithNameMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsContext a) => O.MethodInfo ContextThrowWithNameMethodInfo a signature where
    overloadedMethod = contextThrowWithName

#endif

-- method Context::get_current
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "JavaScriptCore" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "jsc_context_get_current" jsc_context_get_current :: 
    IO (Ptr Context)

-- | Get the t'GI.JavaScriptCore.Objects.Context.Context' that is currently executing a function. This should only be
-- called within a function or method callback, otherwise 'P.Nothing' will be returned.
contextGetCurrent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m (Maybe Context)
    -- ^ __Returns:__ the t'GI.JavaScriptCore.Objects.Context.Context' that is currently executing.
contextGetCurrent :: m (Maybe Context)
contextGetCurrent  = IO (Maybe Context) -> m (Maybe Context)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Context) -> m (Maybe Context))
-> IO (Maybe Context) -> m (Maybe Context)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
result <- IO (Ptr Context)
jsc_context_get_current
    Maybe Context
maybeResult <- Ptr Context -> (Ptr Context -> IO Context) -> IO (Maybe Context)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Context
result ((Ptr Context -> IO Context) -> IO (Maybe Context))
-> (Ptr Context -> IO Context) -> IO (Maybe Context)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr Context
result' -> do
        Context
result'' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Context -> Context
Context) Ptr Context
result'
        Context -> IO Context
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result''
    Maybe Context -> IO (Maybe Context)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Context
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif