{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

A structure representing one of the MIME types associated with a
plugin. A 'GI.GLib.Structs.SList.SList' of these objects will be returned by
@/webkit_web_plugin_get_mimetypes/@, use
@/webkit_web_plugin_mime_type_list_free/@ to free it.
-}

module GI.WebKit.Structs.WebPluginMIMEType
    ( 

-- * Exported types
    WebPluginMIMEType(..)                   ,
    newZeroWebPluginMIMEType                ,
    noWebPluginMIMEType                     ,


 -- * Properties
-- ** description #attr:description#
    clearWebPluginMIMETypeDescription       ,
    getWebPluginMIMETypeDescription         ,
    setWebPluginMIMETypeDescription         ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    webPluginMIMEType_description           ,
#endif


-- ** extensions #attr:extensions#
    clearWebPluginMIMETypeExtensions        ,
    getWebPluginMIMETypeExtensions          ,
    setWebPluginMIMETypeExtensions          ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    webPluginMIMEType_extensions            ,
#endif


-- ** name #attr:name#
    clearWebPluginMIMETypeName              ,
    getWebPluginMIMETypeName                ,
    setWebPluginMIMETypeName                ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    webPluginMIMEType_name                  ,
#endif




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP


newtype WebPluginMIMEType = WebPluginMIMEType (ManagedPtr WebPluginMIMEType)
instance WrappedPtr WebPluginMIMEType where
    wrappedPtrCalloc = callocBytes 24
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 24 >=> wrapPtr WebPluginMIMEType)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `WebPluginMIMEType` struct initialized to zero.
newZeroWebPluginMIMEType :: MonadIO m => m WebPluginMIMEType
newZeroWebPluginMIMEType = liftIO $ wrappedPtrCalloc >>= wrapPtr WebPluginMIMEType

instance tag ~ 'AttrSet => Constructible WebPluginMIMEType tag where
    new _ attrs = do
        o <- newZeroWebPluginMIMEType
        GI.Attributes.set o attrs
        return o


noWebPluginMIMEType :: Maybe WebPluginMIMEType
noWebPluginMIMEType = Nothing

getWebPluginMIMETypeName :: MonadIO m => WebPluginMIMEType -> m (Maybe T.Text)
getWebPluginMIMETypeName s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setWebPluginMIMETypeName :: MonadIO m => WebPluginMIMEType -> CString -> m ()
setWebPluginMIMETypeName s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: CString)

clearWebPluginMIMETypeName :: MonadIO m => WebPluginMIMEType -> m ()
clearWebPluginMIMETypeName s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data WebPluginMIMETypeNameFieldInfo
instance AttrInfo WebPluginMIMETypeNameFieldInfo where
    type AttrAllowedOps WebPluginMIMETypeNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint WebPluginMIMETypeNameFieldInfo = (~) CString
    type AttrBaseTypeConstraint WebPluginMIMETypeNameFieldInfo = (~) WebPluginMIMEType
    type AttrGetType WebPluginMIMETypeNameFieldInfo = Maybe T.Text
    type AttrLabel WebPluginMIMETypeNameFieldInfo = "name"
    type AttrOrigin WebPluginMIMETypeNameFieldInfo = WebPluginMIMEType
    attrGet _ = getWebPluginMIMETypeName
    attrSet _ = setWebPluginMIMETypeName
    attrConstruct = undefined
    attrClear _ = clearWebPluginMIMETypeName

webPluginMIMEType_name :: AttrLabelProxy "name"
webPluginMIMEType_name = AttrLabelProxy

#endif


getWebPluginMIMETypeDescription :: MonadIO m => WebPluginMIMEType -> m (Maybe T.Text)
getWebPluginMIMETypeDescription s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setWebPluginMIMETypeDescription :: MonadIO m => WebPluginMIMEType -> CString -> m ()
setWebPluginMIMETypeDescription s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: CString)

clearWebPluginMIMETypeDescription :: MonadIO m => WebPluginMIMEType -> m ()
clearWebPluginMIMETypeDescription s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data WebPluginMIMETypeDescriptionFieldInfo
instance AttrInfo WebPluginMIMETypeDescriptionFieldInfo where
    type AttrAllowedOps WebPluginMIMETypeDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint WebPluginMIMETypeDescriptionFieldInfo = (~) CString
    type AttrBaseTypeConstraint WebPluginMIMETypeDescriptionFieldInfo = (~) WebPluginMIMEType
    type AttrGetType WebPluginMIMETypeDescriptionFieldInfo = Maybe T.Text
    type AttrLabel WebPluginMIMETypeDescriptionFieldInfo = "description"
    type AttrOrigin WebPluginMIMETypeDescriptionFieldInfo = WebPluginMIMEType
    attrGet _ = getWebPluginMIMETypeDescription
    attrSet _ = setWebPluginMIMETypeDescription
    attrConstruct = undefined
    attrClear _ = clearWebPluginMIMETypeDescription

webPluginMIMEType_description :: AttrLabelProxy "description"
webPluginMIMEType_description = AttrLabelProxy

#endif


getWebPluginMIMETypeExtensions :: MonadIO m => WebPluginMIMEType -> m (Maybe T.Text)
getWebPluginMIMETypeExtensions s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 16) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setWebPluginMIMETypeExtensions :: MonadIO m => WebPluginMIMEType -> CString -> m ()
setWebPluginMIMETypeExtensions s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (val :: CString)

clearWebPluginMIMETypeExtensions :: MonadIO m => WebPluginMIMEType -> m ()
clearWebPluginMIMETypeExtensions s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 16) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data WebPluginMIMETypeExtensionsFieldInfo
instance AttrInfo WebPluginMIMETypeExtensionsFieldInfo where
    type AttrAllowedOps WebPluginMIMETypeExtensionsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint WebPluginMIMETypeExtensionsFieldInfo = (~) CString
    type AttrBaseTypeConstraint WebPluginMIMETypeExtensionsFieldInfo = (~) WebPluginMIMEType
    type AttrGetType WebPluginMIMETypeExtensionsFieldInfo = Maybe T.Text
    type AttrLabel WebPluginMIMETypeExtensionsFieldInfo = "extensions"
    type AttrOrigin WebPluginMIMETypeExtensionsFieldInfo = WebPluginMIMEType
    attrGet _ = getWebPluginMIMETypeExtensions
    attrSet _ = setWebPluginMIMETypeExtensions
    attrConstruct = undefined
    attrClear _ = clearWebPluginMIMETypeExtensions

webPluginMIMEType_extensions :: AttrLabelProxy "extensions"
webPluginMIMEType_extensions = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList WebPluginMIMEType
type instance O.AttributeList WebPluginMIMEType = WebPluginMIMETypeAttributeList
type WebPluginMIMETypeAttributeList = ('[ '("name", WebPluginMIMETypeNameFieldInfo), '("description", WebPluginMIMETypeDescriptionFieldInfo), '("extensions", WebPluginMIMETypeExtensionsFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveWebPluginMIMETypeMethod (t :: Symbol) (o :: *) :: * where
    ResolveWebPluginMIMETypeMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveWebPluginMIMETypeMethod t WebPluginMIMEType, O.MethodInfo info WebPluginMIMEType p) => O.IsLabelProxy t (WebPluginMIMEType -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveWebPluginMIMETypeMethod t WebPluginMIMEType, O.MethodInfo info WebPluginMIMEType p) => O.IsLabel t (WebPluginMIMEType -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#else
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif
#endif

#endif