{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.WebKit2.Structs.MimeInfo
    ( 

-- * Exported types
    MimeInfo(..)                            ,
    noMimeInfo                              ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveMimeInfoMethod                   ,
#endif


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    MimeInfoGetDescriptionMethodInfo        ,
#endif
    mimeInfoGetDescription                  ,


-- ** getExtensions #method:getExtensions#

#if defined(ENABLE_OVERLOADING)
    MimeInfoGetExtensionsMethodInfo         ,
#endif
    mimeInfoGetExtensions                   ,


-- ** getMimeType #method:getMimeType#

#if defined(ENABLE_OVERLOADING)
    MimeInfoGetMimeTypeMethodInfo           ,
#endif
    mimeInfoGetMimeType                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    MimeInfoRefMethodInfo                   ,
#endif
    mimeInfoRef                             ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    MimeInfoUnrefMethodInfo                 ,
#endif
    mimeInfoUnref                           ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
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
import qualified GHC.OverloadedLabels as OL


-- | Memory-managed wrapper type.
newtype MimeInfo = MimeInfo (ManagedPtr MimeInfo)
    deriving (MimeInfo -> MimeInfo -> Bool
(MimeInfo -> MimeInfo -> Bool)
-> (MimeInfo -> MimeInfo -> Bool) -> Eq MimeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MimeInfo -> MimeInfo -> Bool
$c/= :: MimeInfo -> MimeInfo -> Bool
== :: MimeInfo -> MimeInfo -> Bool
$c== :: MimeInfo -> MimeInfo -> Bool
Eq)
foreign import ccall "webkit_mime_info_get_type" c_webkit_mime_info_get_type :: 
    IO GType

instance BoxedObject MimeInfo where
    boxedType :: MimeInfo -> IO GType
boxedType _ = IO GType
c_webkit_mime_info_get_type

-- | Convert 'MimeInfo' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue MimeInfo where
    toGValue :: MimeInfo -> IO GValue
toGValue o :: MimeInfo
o = do
        GType
gtype <- IO GType
c_webkit_mime_info_get_type
        MimeInfo -> (Ptr MimeInfo -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MimeInfo
o (GType
-> (GValue -> Ptr MimeInfo -> IO ()) -> Ptr MimeInfo -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr MimeInfo -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO MimeInfo
fromGValue gv :: GValue
gv = do
        Ptr MimeInfo
ptr <- GValue -> IO (Ptr MimeInfo)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr MimeInfo)
        (ManagedPtr MimeInfo -> MimeInfo) -> Ptr MimeInfo -> IO MimeInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr MimeInfo -> MimeInfo
MimeInfo Ptr MimeInfo
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `MimeInfo`.
noMimeInfo :: Maybe MimeInfo
noMimeInfo :: Maybe MimeInfo
noMimeInfo = Maybe MimeInfo
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MimeInfo
type instance O.AttributeList MimeInfo = MimeInfoAttributeList
type MimeInfoAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method MimeInfo::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "MimeInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitMimeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_mime_info_get_description" webkit_mime_info_get_description :: 
    Ptr MimeInfo ->                         -- info : TInterface (Name {namespace = "WebKit2", name = "MimeInfo"})
    IO CString

-- | /No description available in the introspection data./
mimeInfoGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MimeInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.MimeInfo.MimeInfo'
    -> m T.Text
    -- ^ __Returns:__ the description of the MIME type of /@info@/
mimeInfoGetDescription :: MimeInfo -> m Text
mimeInfoGetDescription info :: MimeInfo
info = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MimeInfo
info' <- MimeInfo -> IO (Ptr MimeInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MimeInfo
info
    CString
result <- Ptr MimeInfo -> IO CString
webkit_mime_info_get_description Ptr MimeInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "mimeInfoGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    MimeInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MimeInfo
info
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MimeInfoGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo MimeInfoGetDescriptionMethodInfo MimeInfo signature where
    overloadedMethod = mimeInfoGetDescription

#endif

-- method MimeInfo::get_extensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "MimeInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitMimeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "webkit_mime_info_get_extensions" webkit_mime_info_get_extensions :: 
    Ptr MimeInfo ->                         -- info : TInterface (Name {namespace = "WebKit2", name = "MimeInfo"})
    IO (Ptr CString)

-- | Get the list of file extensions associated to the
-- MIME type of /@info@/
mimeInfoGetExtensions ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MimeInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.MimeInfo.MimeInfo'
    -> m [T.Text]
    -- ^ __Returns:__ a
    --     'P.Nothing'-terminated array of strings
mimeInfoGetExtensions :: MimeInfo -> m [Text]
mimeInfoGetExtensions info :: MimeInfo
info = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr MimeInfo
info' <- MimeInfo -> IO (Ptr MimeInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MimeInfo
info
    Ptr CString
result <- Ptr MimeInfo -> IO (Ptr CString)
webkit_mime_info_get_extensions Ptr MimeInfo
info'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "mimeInfoGetExtensions" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    MimeInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MimeInfo
info
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data MimeInfoGetExtensionsMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.MethodInfo MimeInfoGetExtensionsMethodInfo MimeInfo signature where
    overloadedMethod = mimeInfoGetExtensions

#endif

-- method MimeInfo::get_mime_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "MimeInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitMimeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_mime_info_get_mime_type" webkit_mime_info_get_mime_type :: 
    Ptr MimeInfo ->                         -- info : TInterface (Name {namespace = "WebKit2", name = "MimeInfo"})
    IO CString

-- | /No description available in the introspection data./
mimeInfoGetMimeType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MimeInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.MimeInfo.MimeInfo'
    -> m T.Text
    -- ^ __Returns:__ the MIME type of /@info@/
mimeInfoGetMimeType :: MimeInfo -> m Text
mimeInfoGetMimeType info :: MimeInfo
info = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr MimeInfo
info' <- MimeInfo -> IO (Ptr MimeInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MimeInfo
info
    CString
result <- Ptr MimeInfo -> IO CString
webkit_mime_info_get_mime_type Ptr MimeInfo
info'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "mimeInfoGetMimeType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    MimeInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MimeInfo
info
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MimeInfoGetMimeTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo MimeInfoGetMimeTypeMethodInfo MimeInfo signature where
    overloadedMethod = mimeInfoGetMimeType

#endif

-- method MimeInfo::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "MimeInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitMimeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "MimeInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_mime_info_ref" webkit_mime_info_ref :: 
    Ptr MimeInfo ->                         -- info : TInterface (Name {namespace = "WebKit2", name = "MimeInfo"})
    IO (Ptr MimeInfo)

-- | Atomically increments the reference count of /@info@/ by one. This
-- function is MT-safe and may be called from any thread.
mimeInfoRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MimeInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.MimeInfo.MimeInfo'
    -> m MimeInfo
    -- ^ __Returns:__ The passed in t'GI.WebKit2.Structs.MimeInfo.MimeInfo'
mimeInfoRef :: MimeInfo -> m MimeInfo
mimeInfoRef info :: MimeInfo
info = IO MimeInfo -> m MimeInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MimeInfo -> m MimeInfo) -> IO MimeInfo -> m MimeInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr MimeInfo
info' <- MimeInfo -> IO (Ptr MimeInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MimeInfo
info
    Ptr MimeInfo
result <- Ptr MimeInfo -> IO (Ptr MimeInfo)
webkit_mime_info_ref Ptr MimeInfo
info'
    Text -> Ptr MimeInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "mimeInfoRef" Ptr MimeInfo
result
    MimeInfo
result' <- ((ManagedPtr MimeInfo -> MimeInfo) -> Ptr MimeInfo -> IO MimeInfo
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MimeInfo -> MimeInfo
MimeInfo) Ptr MimeInfo
result
    MimeInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MimeInfo
info
    MimeInfo -> IO MimeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return MimeInfo
result'

#if defined(ENABLE_OVERLOADING)
data MimeInfoRefMethodInfo
instance (signature ~ (m MimeInfo), MonadIO m) => O.MethodInfo MimeInfoRefMethodInfo MimeInfo signature where
    overloadedMethod = mimeInfoRef

#endif

-- method MimeInfo::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "MimeInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitMimeInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_mime_info_unref" webkit_mime_info_unref :: 
    Ptr MimeInfo ->                         -- info : TInterface (Name {namespace = "WebKit2", name = "MimeInfo"})
    IO ()

-- | Atomically decrements the reference count of /@info@/ by one. If the
-- reference count drops to 0, all memory allocated by the t'GI.WebKit2.Structs.MimeInfo.MimeInfo' is
-- released. This function is MT-safe and may be called from any
-- thread.
mimeInfoUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MimeInfo
    -- ^ /@info@/: a t'GI.WebKit2.Structs.MimeInfo.MimeInfo'
    -> m ()
mimeInfoUnref :: MimeInfo -> m ()
mimeInfoUnref info :: MimeInfo
info = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MimeInfo
info' <- MimeInfo -> IO (Ptr MimeInfo)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MimeInfo
info
    Ptr MimeInfo -> IO ()
webkit_mime_info_unref Ptr MimeInfo
info'
    MimeInfo -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MimeInfo
info
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MimeInfoUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MimeInfoUnrefMethodInfo MimeInfo signature where
    overloadedMethod = mimeInfoUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMimeInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveMimeInfoMethod "ref" o = MimeInfoRefMethodInfo
    ResolveMimeInfoMethod "unref" o = MimeInfoUnrefMethodInfo
    ResolveMimeInfoMethod "getDescription" o = MimeInfoGetDescriptionMethodInfo
    ResolveMimeInfoMethod "getExtensions" o = MimeInfoGetExtensionsMethodInfo
    ResolveMimeInfoMethod "getMimeType" o = MimeInfoGetMimeTypeMethodInfo
    ResolveMimeInfoMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMimeInfoMethod t MimeInfo, O.MethodInfo info MimeInfo p) => OL.IsLabel t (MimeInfo -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif