-- GENERATED by C->Haskell Compiler, version 0.13.12 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGNAL .chs file instead!

{-# LANGUAGE EmptyDataDecls,ForeignFunctionInterface #-}

{-# LINE 1 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef where

import Foreign.Ptr 
import Foreign.C.Types 

-- import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
-- import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef 

import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
{-# LINE 11 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

-- {#pointer JSGlobalContextRef as JSGlobalContextRef -> OpaqueJSContext #}

jscontextgroupcreate :: IO (JSContextGroupRef)
jscontextgroupcreate =
  jscontextgroupcreate'_ >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 15 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jscontextgroupretain :: JSContextGroupRef -> IO (JSContextGroupRef)
jscontextgroupretain a1 =
  let {a1' = id a1} in 
  jscontextgroupretain'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 17 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jscontextgrouprelease :: JSContextGroupRef -> IO ()
jscontextgrouprelease a1 =
  let {a1' = id a1} in 
  jscontextgrouprelease'_ a1' >>= \res ->
  return ()
{-# LINE 19 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jsglobalcontextcreate :: JSClassRef -> IO (JSGlobalContextRef)
jsglobalcontextcreate a1 =
  let {a1' = id a1} in 
  jsglobalcontextcreate'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 21 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jsglobalcontextcreateingroup :: JSContextGroupRef -> JSClassRef -> IO (JSGlobalContextRef)
jsglobalcontextcreateingroup a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  jsglobalcontextcreateingroup'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 23 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jsglobalcontextretain :: JSGlobalContextRef -> IO (JSGlobalContextRef)
jsglobalcontextretain a1 =
  let {a1' = id a1} in 
  jsglobalcontextretain'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 25 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jsglobalcontextrelease :: JSGlobalContextRef -> IO ()
jsglobalcontextrelease a1 =
  let {a1' = id a1} in 
  jsglobalcontextrelease'_ a1' >>= \res ->
  return ()
{-# LINE 27 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jscontextgetglobalobject :: JSContextRef -> IO (JSObjectRef)
jscontextgetglobalobject a1 =
  let {a1' = id a1} in 
  jscontextgetglobalobject'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 29 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}

jscontextgetgroup :: JSContextRef -> IO (JSContextGroupRef)
jscontextgetgroup a1 =
  let {a1' = id a1} in 
  jscontextgetgroup'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 31 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs" #-}


foreign import ccall safe "JSContextGroupCreate"
  jscontextgroupcreate'_ :: (IO (Ptr OpaqueJSContextGroup))

foreign import ccall safe "JSContextGroupRetain"
  jscontextgroupretain'_ :: ((Ptr OpaqueJSContextGroup) -> (IO (Ptr OpaqueJSContextGroup)))

foreign import ccall safe "JSContextGroupRelease"
  jscontextgrouprelease'_ :: ((Ptr OpaqueJSContextGroup) -> (IO ()))

foreign import ccall safe "JSGlobalContextCreate"
  jsglobalcontextcreate'_ :: ((Ptr OpaqueJSClass) -> (IO (Ptr OpaqueJSContext)))

foreign import ccall safe "JSGlobalContextCreateInGroup"
  jsglobalcontextcreateingroup'_ :: ((Ptr OpaqueJSContextGroup) -> ((Ptr OpaqueJSClass) -> (IO (Ptr OpaqueJSContext))))

foreign import ccall safe "JSGlobalContextRetain"
  jsglobalcontextretain'_ :: ((Ptr OpaqueJSContext) -> (IO (Ptr OpaqueJSContext)))

foreign import ccall safe "JSGlobalContextRelease"
  jsglobalcontextrelease'_ :: ((Ptr OpaqueJSContext) -> (IO ()))

foreign import ccall safe "JSContextGetGlobalObject"
  jscontextgetglobalobject'_ :: ((Ptr OpaqueJSContext) -> (IO (Ptr OpaqueJSValue)))

foreign import ccall safe "JSContextGetGroup"
  jscontextgetgroup'_ :: ((Ptr OpaqueJSContext) -> (IO (Ptr OpaqueJSContextGroup)))