-- 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/Plugin.chs" #-}
module Graphics.UI.Gtk.WebKit.DOM.Plugin(
item,
namedItem,
getName,
getFilename,
getDescription,
getLength,
Plugin,
castToPlugin,
gTypePlugin,
PluginClass,
toPlugin,
) 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 25 "./Graphics/UI/Gtk/WebKit/DOM/Plugin.chs" #-}
import Graphics.UI.Gtk.WebKit.DOM.Enums

 
item ::
     (MonadIO m, PluginClass self) => self -> Word -> m (Maybe MimeType)
item self index
  = liftIO
      (maybeNull (makeNewGObject mkMimeType)
         ((\(Plugin arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_plugin_item argPtr1 arg2) (toPlugin self)
            (fromIntegral index)))
 
namedItem ::
          (MonadIO m, PluginClass self, GlibString string) =>
            self -> string -> m (Maybe MimeType)
namedItem self name
  = liftIO
      (maybeNull (makeNewGObject mkMimeType)
         (withUTFString name $
            \ namePtr ->
              (\(Plugin arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_plugin_named_item argPtr1 arg2) (toPlugin self)
                namePtr))
 
getName ::
        (MonadIO m, PluginClass self, GlibString string) =>
          self -> m string
getName self
  = liftIO
      (((\(Plugin arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_plugin_get_name argPtr1) (toPlugin self)) >>=
         readUTFString)
 
getFilename ::
            (MonadIO m, PluginClass self, GlibString string) =>
              self -> m string
getFilename self
  = liftIO
      (((\(Plugin arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_plugin_get_filename argPtr1) (toPlugin self))
         >>=
         readUTFString)
 
getDescription ::
               (MonadIO m, PluginClass self, GlibString string) =>
                 self -> m string
getDescription self
  = liftIO
      (((\(Plugin arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_plugin_get_description argPtr1) (toPlugin self))
         >>=
         readUTFString)
 
getLength :: (MonadIO m, PluginClass self) => self -> m Word
getLength self
  = liftIO
      (fromIntegral <$>
         ((\(Plugin arg1) -> withForeignPtr arg1 $ \argPtr1 ->webkit_dom_dom_plugin_get_length argPtr1) (toPlugin self)))

foreign import ccall safe "webkit_dom_dom_plugin_item"
  webkit_dom_dom_plugin_item :: ((Ptr Plugin) -> (CULong -> (IO (Ptr MimeType))))

foreign import ccall safe "webkit_dom_dom_plugin_named_item"
  webkit_dom_dom_plugin_named_item :: ((Ptr Plugin) -> ((Ptr CChar) -> (IO (Ptr MimeType))))

foreign import ccall safe "webkit_dom_dom_plugin_get_name"
  webkit_dom_dom_plugin_get_name :: ((Ptr Plugin) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_dom_dom_plugin_get_filename"
  webkit_dom_dom_plugin_get_filename :: ((Ptr Plugin) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_dom_dom_plugin_get_description"
  webkit_dom_dom_plugin_get_description :: ((Ptr Plugin) -> (IO (Ptr CChar)))

foreign import ccall safe "webkit_dom_dom_plugin_get_length"
  webkit_dom_dom_plugin_get_length :: ((Ptr Plugin) -> (IO CULong))