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


{-# LINE 1 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.DOMImplementation(
hasFeature,
createDocumentType,
createDocument,
createCSSStyleSheet,
createHTMLDocument,
DOMImplementation,
castToDOMImplementation,
gTypeDOMImplementation,
DOMImplementationClass,
toDOMImplementation,
) where
import Prelude hiding (drop, error, print)
import Data.Typeable (Typeable)
import Foreign.Marshal (maybePeek, maybeWith)
import System.Glib.FFI (maybeNull, withForeignPtr, nullForeignPtr, Ptr, nullPtr, castPtr, Word, Int64, Word64, CChar(..), CInt(..), CUInt(..), CLong(..), CULong(..), CLLong(..), CULLong(..), CShort(..), CUShort(..), CFloat(..), CDouble(..), toBool, fromBool)
import System.Glib.UTFString (GlibString(..), readUTFString)
import Control.Applicative ((<$>))
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import System.Glib.GError
import Graphics.UI.Gtk.WebKit.DOM.EventTargetClosures
import Graphics.UI.Gtk.WebKit.DOM.EventM
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 24 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
import Graphics.UI.Gtk.WebKit.DOM.Enums

 
hasFeature ::
           (MonadIO m, DOMImplementationClass self, GlibString string) =>
             self -> string -> (Maybe string) -> m Bool
hasFeature self feature version
  = liftIO
      (toBool <$>
         (maybeWith withUTFString version $
            \ versionPtr ->
              withUTFString feature $
                \ featurePtr ->
                  (\(DOMImplementation arg1) arg2 arg3 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_implementation_has_feature argPtr1 arg2 arg3)
{-# LINE 38 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
                    (toDOMImplementation self)
                    featurePtr
                versionPtr))
 
createDocumentType ::
                   (MonadIO m, DOMImplementationClass self, GlibString string) =>
                     self ->
                       (Maybe string) ->
                         (Maybe string) -> (Maybe string) -> m (Maybe DocumentType)
createDocumentType self qualifiedName publicId systemId
  = liftIO
      (maybeNull (makeNewGObject mkDocumentType)
         (propagateGError $
            \ errorPtr_ ->
              maybeWith withUTFString systemId $
                \ systemIdPtr ->
                  maybeWith withUTFString publicId $
                    \ publicIdPtr ->
                      maybeWith withUTFString qualifiedName $
                        \ qualifiedNamePtr ->
                          (\(DOMImplementation arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_implementation_create_document_type argPtr1 arg2 arg3 arg4 arg5)
{-# LINE 59 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
                            (toDOMImplementation self)
                            qualifiedNamePtr
                        publicIdPtr
                    systemIdPtr
                errorPtr_))
 
createDocument ::
               (MonadIO m, DOMImplementationClass self, DocumentTypeClass doctype,
                GlibString string) =>
                 self ->
                   (Maybe string) ->
                     (Maybe string) -> Maybe doctype -> m (Maybe Document)
createDocument self namespaceURI qualifiedName doctype
  = liftIO
      (maybeNull (makeNewGObject mkDocument)
         (propagateGError $
            \ errorPtr_ ->
              maybeWith withUTFString qualifiedName $
                \ qualifiedNamePtr ->
                  maybeWith withUTFString namespaceURI $
                    \ namespaceURIPtr ->
                      (\(DOMImplementation arg1) arg2 arg3 (DocumentType arg4) arg5 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg4 $ \argPtr4 ->webkit_dom_dom_implementation_create_document argPtr1 arg2 arg3 argPtr4 arg5)
{-# LINE 81 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
                        (toDOMImplementation self)
                        namespaceURIPtr
                    qualifiedNamePtr
                (maybe (DocumentType nullForeignPtr) toDocumentType doctype)
                errorPtr_))
 
createCSSStyleSheet ::
                    (MonadIO m, DOMImplementationClass self, GlibString string) =>
                      self -> string -> string -> m (Maybe CSSStyleSheet)
createCSSStyleSheet self title media
  = liftIO
      (maybeNull (makeNewGObject mkCSSStyleSheet)
         (propagateGError $
            \ errorPtr_ ->
              withUTFString media $
                \ mediaPtr ->
                  withUTFString title $
                    \ titlePtr ->
                      (\(DOMImplementation arg1) arg2 arg3 arg4 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_implementation_create_css_style_sheet argPtr1 arg2 arg3 arg4)
{-# LINE 100 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
                        (toDOMImplementation self)
                        titlePtr
                    mediaPtr
                errorPtr_))
 
createHTMLDocument ::
                   (MonadIO m, DOMImplementationClass self, GlibString string) =>
                     self -> string -> m (Maybe HTMLDocument)
createHTMLDocument self title
  = liftIO
      (maybeNull (makeNewGObject mkHTMLDocument)
         (withUTFString title $
            \ titlePtr ->
              (\(DOMImplementation arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_implementation_create_html_document argPtr1 arg2)
{-# LINE 114 "./Graphics/UI/Gtk/WebKit/DOM/DOMImplementation.chs" #-}
                (toDOMImplementation self)
                titlePtr))

foreign import ccall safe "webkit_dom_dom_implementation_has_feature"
  webkit_dom_dom_implementation_has_feature :: ((Ptr DOMImplementation) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO CInt))))

foreign import ccall safe "webkit_dom_dom_implementation_create_document_type"
  webkit_dom_dom_implementation_create_document_type :: ((Ptr DOMImplementation) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr DocumentType)))))))

foreign import ccall safe "webkit_dom_dom_implementation_create_document"
  webkit_dom_dom_implementation_create_document :: ((Ptr DOMImplementation) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr DocumentType) -> ((Ptr (Ptr ())) -> (IO (Ptr Document)))))))

foreign import ccall safe "webkit_dom_dom_implementation_create_css_style_sheet"
  webkit_dom_dom_implementation_create_css_style_sheet :: ((Ptr DOMImplementation) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr (Ptr ())) -> (IO (Ptr CSSStyleSheet))))))

foreign import ccall safe "webkit_dom_dom_implementation_create_html_document"
  webkit_dom_dom_implementation_create_html_document :: ((Ptr DOMImplementation) -> ((Ptr CChar) -> (IO (Ptr HTMLDocument))))