-- 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/HTMLFormElement.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.HTMLFormElement(
submit,
reset,
checkValidity,
setAcceptCharset,
getAcceptCharset,
setAction,
getAction,
setAutocomplete,
getAutocomplete,
setEnctype,
getEnctype,
setEncoding,
getEncoding,
setMethod,
getMethod,
setName,
getName,
setNoValidate,
getNoValidate,
setTarget,
getTarget,
getElements,
getLength,
setAutocorrect,
getAutocorrect,
setAutocapitalize,
getAutocapitalize,
autocomplete,
autocompleteerror,
HTMLFormElement,
castToHTMLFormElement,
gTypeHTMLFormElement,
HTMLFormElementClass,
toHTMLFormElement,
) 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 53 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
import Graphics.UI.Gtk.WebKit.DOM.Enums

 
submit :: (MonadIO m, HTMLFormElementClass self) => self -> m ()
submit self
  = liftIO
      ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_submit argPtr1)
{-# LINE 60 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
         (toHTMLFormElement self))
 
reset :: (MonadIO m, HTMLFormElementClass self) => self -> m ()
reset self
  = liftIO
      ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_reset argPtr1)
{-# LINE 66 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
         (toHTMLFormElement self))
 
checkValidity ::
              (MonadIO m, HTMLFormElementClass self) => self -> m Bool
checkValidity self
  = liftIO
      (toBool <$>
         ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_check_validity argPtr1)
{-# LINE 74 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
            (toHTMLFormElement self)))

 
setAcceptCharset ::
                 (MonadIO m, HTMLFormElementClass self, GlibString string) =>
                   self -> string -> m ()
setAcceptCharset self val
  = liftIO
      (withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_accept_charset argPtr1 arg2)
{-# LINE 93 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getAcceptCharset ::
                 (MonadIO m, HTMLFormElementClass self, GlibString string) =>
                   self -> m string
getAcceptCharset self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_accept_charset argPtr1)
{-# LINE 102 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         readUTFString)
 
setAction ::
          (MonadIO m, HTMLFormElementClass self, GlibString string) =>
            self -> string -> m ()
setAction self val
  = liftIO
      (withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_action argPtr1 arg2)
{-# LINE 114 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getAction ::
          (MonadIO m, HTMLFormElementClass self, GlibString string) =>
            self -> m string
getAction self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_action argPtr1)
{-# LINE 123 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         readUTFString)
 
setAutocomplete ::
                (MonadIO m, HTMLFormElementClass self, GlibString string) =>
                  self -> string -> m ()
setAutocomplete self val
  = liftIO
      (withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_autocomplete argPtr1 arg2)
{-# LINE 135 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getAutocomplete ::
                (MonadIO m, HTMLFormElementClass self, GlibString string) =>
                  self -> m string
getAutocomplete self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_autocomplete argPtr1)
{-# LINE 144 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         readUTFString)
 
setEnctype ::
           (MonadIO m, HTMLFormElementClass self, GlibString string) =>
             self -> (Maybe string) -> m ()
setEnctype self val
  = liftIO
      (maybeWith withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_enctype argPtr1 arg2)
{-# LINE 156 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getEnctype ::
           (MonadIO m, HTMLFormElementClass self, GlibString string) =>
             self -> m (Maybe string)
getEnctype self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_enctype argPtr1)
{-# LINE 165 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         maybePeek readUTFString)
 
setEncoding ::
            (MonadIO m, HTMLFormElementClass self, GlibString string) =>
              self -> (Maybe string) -> m ()
setEncoding self val
  = liftIO
      (maybeWith withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_encoding argPtr1 arg2)
{-# LINE 177 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getEncoding ::
            (MonadIO m, HTMLFormElementClass self, GlibString string) =>
              self -> m (Maybe string)
getEncoding self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_encoding argPtr1)
{-# LINE 186 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         maybePeek readUTFString)
 
setMethod ::
          (MonadIO m, HTMLFormElementClass self, GlibString string) =>
            self -> (Maybe string) -> m ()
setMethod self val
  = liftIO
      (maybeWith withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_method argPtr1 arg2)
{-# LINE 198 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getMethod ::
          (MonadIO m, HTMLFormElementClass self, GlibString string) =>
            self -> m (Maybe string)
getMethod self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_method argPtr1)
{-# LINE 207 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         maybePeek readUTFString)
 
setName ::
        (MonadIO m, HTMLFormElementClass self, GlibString string) =>
          self -> string -> m ()
setName self val
  = liftIO
      (withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_name argPtr1 arg2)
{-# LINE 219 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getName ::
        (MonadIO m, HTMLFormElementClass self, GlibString string) =>
          self -> m string
getName self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_name argPtr1)
{-# LINE 228 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         readUTFString)
 
setNoValidate ::
              (MonadIO m, HTMLFormElementClass self) => self -> Bool -> m ()
setNoValidate self val
  = liftIO
      ((\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_no_validate argPtr1 arg2)
{-# LINE 237 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
         (toHTMLFormElement self)
         (fromBool val))
 
getNoValidate ::
              (MonadIO m, HTMLFormElementClass self) => self -> m Bool
getNoValidate self
  = liftIO
      (toBool <$>
         ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_no_validate argPtr1)
{-# LINE 246 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
            (toHTMLFormElement self)))
 
setTarget ::
          (MonadIO m, HTMLFormElementClass self, GlibString string) =>
            self -> string -> m ()
setTarget self val
  = liftIO
      (withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_target argPtr1 arg2)
{-# LINE 256 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getTarget ::
          (MonadIO m, HTMLFormElementClass self, GlibString string) =>
            self -> m string
getTarget self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_target argPtr1)
{-# LINE 265 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         readUTFString)
 
getElements ::
            (MonadIO m, HTMLFormElementClass self) =>
              self -> m (Maybe HTMLCollection)
getElements self
  = liftIO
      (maybeNull (makeNewGObject mkHTMLCollection)
         ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_elements argPtr1)
{-# LINE 276 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
            (toHTMLFormElement self)))
 
getLength ::
          (MonadIO m, HTMLFormElementClass self) => self -> m Int
getLength self
  = liftIO
      (fromIntegral <$>
         ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_length argPtr1)
{-# LINE 284 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
            (toHTMLFormElement self)))

setAutocorrect ::
               (MonadIO m, HTMLFormElementClass self) => self -> Bool -> m ()
setAutocorrect self val
  = liftIO
      ((\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_autocorrect argPtr1 arg2)
{-# LINE 292 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
         (toHTMLFormElement self)
         (fromBool val))
 
getAutocorrect ::
               (MonadIO m, HTMLFormElementClass self) => self -> m Bool
getAutocorrect self
  = liftIO
      (toBool <$>
         ((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_autocorrect argPtr1)
{-# LINE 301 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
            (toHTMLFormElement self)))
 
setAutocapitalize ::
                  (MonadIO m, HTMLFormElementClass self, GlibString string) =>
                    self -> (Maybe string) -> m ()
setAutocapitalize self val
  = liftIO
      (maybeWith withUTFString val $
         \ valPtr ->
           (\(HTMLFormElement arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_set_autocapitalize argPtr1 arg2)
{-# LINE 311 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
             (toHTMLFormElement self)
             valPtr)
 
getAutocapitalize ::
                  (MonadIO m, HTMLFormElementClass self, GlibString string) =>
                    self -> m (Maybe string)
getAutocapitalize self
  = liftIO
      (((\(HTMLFormElement arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_html_form_element_get_autocapitalize argPtr1)
{-# LINE 320 "./Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.chs" #-}
          (toHTMLFormElement self))
         >>=
         maybePeek readUTFString)
 
autocomplete :: (HTMLFormElementClass self) => EventName self Event
autocomplete = EventName "autocomplete"
 
autocompleteerror ::
                  (HTMLFormElementClass self) => EventName self Event
autocompleteerror = EventName "autocompleteerror"

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_submit"
  webkit_dom_html_form_element_submit :: ((Ptr HTMLFormElement) -> (IO ()))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_reset"
  webkit_dom_html_form_element_reset :: ((Ptr HTMLFormElement) -> (IO ()))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_check_validity"
  webkit_dom_html_form_element_check_validity :: ((Ptr HTMLFormElement) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_accept_charset"
  webkit_dom_html_form_element_set_accept_charset :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_accept_charset"
  webkit_dom_html_form_element_get_accept_charset :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_action"
  webkit_dom_html_form_element_set_action :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_action"
  webkit_dom_html_form_element_get_action :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_autocomplete"
  webkit_dom_html_form_element_set_autocomplete :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_autocomplete"
  webkit_dom_html_form_element_get_autocomplete :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_enctype"
  webkit_dom_html_form_element_set_enctype :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_enctype"
  webkit_dom_html_form_element_get_enctype :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_encoding"
  webkit_dom_html_form_element_set_encoding :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_encoding"
  webkit_dom_html_form_element_get_encoding :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_method"
  webkit_dom_html_form_element_set_method :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_method"
  webkit_dom_html_form_element_get_method :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_name"
  webkit_dom_html_form_element_set_name :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_name"
  webkit_dom_html_form_element_get_name :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_no_validate"
  webkit_dom_html_form_element_set_no_validate :: ((Ptr HTMLFormElement) -> (CInt -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_no_validate"
  webkit_dom_html_form_element_get_no_validate :: ((Ptr HTMLFormElement) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_target"
  webkit_dom_html_form_element_set_target :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_target"
  webkit_dom_html_form_element_get_target :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_elements"
  webkit_dom_html_form_element_get_elements :: ((Ptr HTMLFormElement) -> (IO (Ptr HTMLCollection)))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_length"
  webkit_dom_html_form_element_get_length :: ((Ptr HTMLFormElement) -> (IO CLong))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_autocorrect"
  webkit_dom_html_form_element_set_autocorrect :: ((Ptr HTMLFormElement) -> (CInt -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_autocorrect"
  webkit_dom_html_form_element_get_autocorrect :: ((Ptr HTMLFormElement) -> (IO CInt))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_set_autocapitalize"
  webkit_dom_html_form_element_set_autocapitalize :: ((Ptr HTMLFormElement) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "dist/build/Graphics/UI/Gtk/WebKit/DOM/HTMLFormElement.h webkit_dom_html_form_element_get_autocapitalize"
  webkit_dom_html_form_element_get_autocapitalize :: ((Ptr HTMLFormElement) -> (IO (Ptr CChar)))