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


{-# LINE 1 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.DOMApplicationCache
       (domApplicationCacheUpdate, domApplicationCacheSwapCache,
        domApplicationCacheAbort, domApplicationCacheDispatchEvent,
        cUNCACHED, cIDLE, cCHECKING, cDOWNLOADING, cUPDATEREADY, cOBSOLETE,
        domApplicationCacheGetStatus, domApplicationCacheOnchecking,
        domApplicationCacheOnerror, domApplicationCacheOnnoupdate,
        domApplicationCacheOndownloading, domApplicationCacheOnprogress,
        domApplicationCacheOnupdateready, domApplicationCacheOncached,
        domApplicationCacheOnobsolete)
       where
import System.Glib.FFI
import System.Glib.UTFString
import Control.Applicative
import Graphics.UI.Gtk.WebKit.Types
{-# LINE 14 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
import System.Glib.GError
import Graphics.UI.Gtk.WebKit.DOM.EventM
 
domApplicationCacheUpdate ::
                          (DOMApplicationCacheClass self) => self -> IO ()
domApplicationCacheUpdate self
  = propagateGError $
      \ errorPtr_ ->
        (\(DOMApplicationCache arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_application_cache_update argPtr1 arg2)
{-# LINE 23 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
          (toDOMApplicationCache self)
          errorPtr_
 
domApplicationCacheSwapCache ::
                             (DOMApplicationCacheClass self) => self -> IO ()
domApplicationCacheSwapCache self
  = propagateGError $
      \ errorPtr_ ->
        (\(DOMApplicationCache arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_application_cache_swap_cache argPtr1 arg2)
{-# LINE 32 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
          (toDOMApplicationCache self)
          errorPtr_
 
domApplicationCacheAbort ::
                         (DOMApplicationCacheClass self) => self -> IO ()
domApplicationCacheAbort self
  = (\(DOMApplicationCache arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_application_cache_abort argPtr1)
{-# LINE 39 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
      (toDOMApplicationCache self)
 
domApplicationCacheDispatchEvent ::
                                 (DOMApplicationCacheClass self, EventClass evt) =>
                                   self -> Maybe evt -> IO Bool
domApplicationCacheDispatchEvent self evt
  = toBool <$>
      (propagateGError $
         \ errorPtr_ ->
           (\(DOMApplicationCache arg1) (Event arg2) arg3 -> withForeignPtr arg1 $ \argPtr1 ->withForeignPtr arg2 $ \argPtr2 ->webkit_dom_dom_application_cache_dispatch_event argPtr1 argPtr2 arg3)
{-# LINE 49 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
             (toDOMApplicationCache self)
             (maybe (Event nullForeignPtr) toEvent evt)
             errorPtr_)
cUNCACHED = 0
cIDLE = 1
cCHECKING = 2
cDOWNLOADING = 3
cUPDATEREADY = 4
cOBSOLETE = 5
 
domApplicationCacheGetStatus ::
                             (DOMApplicationCacheClass self) => self -> IO Word
domApplicationCacheGetStatus self
  = fromIntegral <$>
      ((\(DOMApplicationCache arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_application_cache_get_status argPtr1)
{-# LINE 64 "./Graphics/UI/Gtk/WebKit/DOM/DOMApplicationCache.chs" #-}
         (toDOMApplicationCache self))
 
domApplicationCacheOnchecking ::
                              (DOMApplicationCacheClass self) =>
                                Signal self (EventM UIEvent self ())
domApplicationCacheOnchecking = (connect "checking")
 
domApplicationCacheOnerror ::
                           (DOMApplicationCacheClass self) =>
                             Signal self (EventM UIEvent self ())
domApplicationCacheOnerror = (connect "error")
 
domApplicationCacheOnnoupdate ::
                              (DOMApplicationCacheClass self) =>
                                Signal self (EventM UIEvent self ())
domApplicationCacheOnnoupdate = (connect "noupdate")
 
domApplicationCacheOndownloading ::
                                 (DOMApplicationCacheClass self) =>
                                   Signal self (EventM UIEvent self ())
domApplicationCacheOndownloading = (connect "downloading")
 
domApplicationCacheOnprogress ::
                              (DOMApplicationCacheClass self) =>
                                Signal self (EventM UIEvent self ())
domApplicationCacheOnprogress = (connect "progress")
 
domApplicationCacheOnupdateready ::
                                 (DOMApplicationCacheClass self) =>
                                   Signal self (EventM UIEvent self ())
domApplicationCacheOnupdateready = (connect "updateready")
 
domApplicationCacheOncached ::
                            (DOMApplicationCacheClass self) =>
                              Signal self (EventM UIEvent self ())
domApplicationCacheOncached = (connect "cached")
 
domApplicationCacheOnobsolete ::
                              (DOMApplicationCacheClass self) =>
                                Signal self (EventM UIEvent self ())
domApplicationCacheOnobsolete = (connect "obsolete")

foreign import ccall safe "webkit_dom_dom_application_cache_update"
  webkit_dom_dom_application_cache_update :: ((Ptr DOMApplicationCache) -> ((Ptr (Ptr ())) -> (IO ())))

foreign import ccall safe "webkit_dom_dom_application_cache_swap_cache"
  webkit_dom_dom_application_cache_swap_cache :: ((Ptr DOMApplicationCache) -> ((Ptr (Ptr ())) -> (IO ())))

foreign import ccall safe "webkit_dom_dom_application_cache_abort"
  webkit_dom_dom_application_cache_abort :: ((Ptr DOMApplicationCache) -> (IO ()))

foreign import ccall safe "webkit_dom_dom_application_cache_dispatch_event"
  webkit_dom_dom_application_cache_dispatch_event :: ((Ptr DOMApplicationCache) -> ((Ptr Event) -> ((Ptr (Ptr ())) -> (IO CInt))))

foreign import ccall safe "webkit_dom_dom_application_cache_get_status"
  webkit_dom_dom_application_cache_get_status :: ((Ptr DOMApplicationCache) -> (IO CUShort))