-- GENERATED by C->Haskell Compiler, version 0.13.9 (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/JSStringRef.chs" #-}

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

import Foreign.Ptr 
import Foreign.C.String
import Foreign.C.Types 

import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
{-# LINE 9 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}
import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
{-# LINE 10 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}

type JSChar = (CUShort)
{-# LINE 12 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}
type JSCharRef = Ptr (JSChar)
{-# LINE 13 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}

jsstringcreatewithcharacters :: JSCharRef -> CSize -> IO (JSStringRef)
jsstringcreatewithcharacters a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  jsstringcreatewithcharacters'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 15 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}

jsstringcreatewithutf8cstring :: String -> IO (JSStringRef)
jsstringcreatewithutf8cstring a1 =
  withCString a1 $ \a1' -> 
  jsstringcreatewithutf8cstring'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 17 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}

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

jsstringrelease :: JSStringRef -> IO ()
jsstringrelease a1 =
  let {a1' = id a1} in 
  jsstringrelease'_ a1' >>= \res ->
  return () 

jsstringgetlength :: JSStringRef -> IO (CSize)
jsstringgetlength a1 =
  let {a1' = id a1} in 
  jsstringgetlength'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')
{-# LINE 23 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}

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

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

jsstringgetutf8cstring :: JSStringRef -> String -> CSize -> IO (CSize)
jsstringgetutf8cstring a1 a2 a3 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  jsstringgetutf8cstring'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')
{-# LINE 29 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}

jsstringisequal :: JSStringRef -> JSStringRef -> IO (Bool)
jsstringisequal a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  jsstringisequal'_ a1' a2' >>= \res ->
  let {res' = getBool res} in
  return (res') 

jsstringisequaltoutf8cstring :: JSStringRef -> String -> IO (Bool)
jsstringisequaltoutf8cstring a1 a2 =
  let {a1' = id a1} in 
  withCString a2 $ \a2' -> 
  jsstringisequaltoutf8cstring'_ a1' a2' >>= \res ->
  let {res' = getBool res} in
  return (res')
{-# LINE 33 "src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs" #-}


foreign import ccall safe "JSStringCreateWithCharacters"
  jsstringcreatewithcharacters'_ :: ((Ptr JSChar) -> (CULong -> (IO (Ptr OpaqueJSString))))

foreign import ccall safe "JSStringCreateWithUTF8CString"
  jsstringcreatewithutf8cstring'_ :: ((Ptr CChar) -> (IO (Ptr OpaqueJSString)))

foreign import ccall safe "JSStringRetain"
  jsstringretain'_ :: ((Ptr OpaqueJSString) -> (IO (Ptr OpaqueJSString)))

foreign import ccall safe "JSStringRelease"
  jsstringrelease'_ :: ((Ptr OpaqueJSString) -> (IO ()))

foreign import ccall safe "JSStringGetLength"
  jsstringgetlength'_ :: ((Ptr OpaqueJSString) -> (IO CULong))

foreign import ccall safe "JSStringGetCharactersPtr"
  jsstringgetcharactersptr'_ :: ((Ptr OpaqueJSString) -> (IO (Ptr JSChar)))

foreign import ccall safe "JSStringGetMaximumUTF8CStringSize"
  jsstringgetmaximumutf8cstringsize'_ :: ((Ptr OpaqueJSString) -> (IO CULong))

foreign import ccall safe "JSStringGetUTF8CString"
  jsstringgetutf8cstring'_ :: ((Ptr OpaqueJSString) -> ((Ptr CChar) -> (CULong -> (IO CULong))))

foreign import ccall safe "JSStringIsEqual"
  jsstringisequal'_ :: ((Ptr OpaqueJSString) -> ((Ptr OpaqueJSString) -> (IO CUChar)))

foreign import ccall safe "JSStringIsEqualToUTF8CString"
  jsstringisequaltoutf8cstring'_ :: ((Ptr OpaqueJSString) -> ((Ptr CChar) -> (IO CUChar)))