{-# 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.GdkPixbuf.Structs.PixbufFormat
    ( 

-- * Exported types
    PixbufFormat(..)                        ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePixbufFormatMethod               ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatCopyMethodInfo              ,
#endif
    pixbufFormatCopy                        ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatFreeMethodInfo              ,
#endif
    pixbufFormatFree                        ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatGetDescriptionMethodInfo    ,
#endif
    pixbufFormatGetDescription              ,


-- ** getExtensions #method:getExtensions#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatGetExtensionsMethodInfo     ,
#endif
    pixbufFormatGetExtensions               ,


-- ** getLicense #method:getLicense#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatGetLicenseMethodInfo        ,
#endif
    pixbufFormatGetLicense                  ,


-- ** getMimeTypes #method:getMimeTypes#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatGetMimeTypesMethodInfo      ,
#endif
    pixbufFormatGetMimeTypes                ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatGetNameMethodInfo           ,
#endif
    pixbufFormatGetName                     ,


-- ** isDisabled #method:isDisabled#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatIsDisabledMethodInfo        ,
#endif
    pixbufFormatIsDisabled                  ,


-- ** isSaveOptionSupported #method:isSaveOptionSupported#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatIsSaveOptionSupportedMethodInfo,
#endif
    pixbufFormatIsSaveOptionSupported       ,


-- ** isScalable #method:isScalable#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatIsScalableMethodInfo        ,
#endif
    pixbufFormatIsScalable                  ,


-- ** isWritable #method:isWritable#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatIsWritableMethodInfo        ,
#endif
    pixbufFormatIsWritable                  ,


-- ** setDisabled #method:setDisabled#

#if defined(ENABLE_OVERLOADING)
    PixbufFormatSetDisabledMethodInfo       ,
#endif
    pixbufFormatSetDisabled                 ,




    ) 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.BasicTypes as B.Types
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 Control.Monad.IO.Class as MIO
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 PixbufFormat = PixbufFormat (SP.ManagedPtr PixbufFormat)
    deriving (PixbufFormat -> PixbufFormat -> Bool
(PixbufFormat -> PixbufFormat -> Bool)
-> (PixbufFormat -> PixbufFormat -> Bool) -> Eq PixbufFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PixbufFormat -> PixbufFormat -> Bool
$c/= :: PixbufFormat -> PixbufFormat -> Bool
== :: PixbufFormat -> PixbufFormat -> Bool
$c== :: PixbufFormat -> PixbufFormat -> Bool
Eq)

instance SP.ManagedPtrNewtype PixbufFormat where
    toManagedPtr :: PixbufFormat -> ManagedPtr PixbufFormat
toManagedPtr (PixbufFormat ManagedPtr PixbufFormat
p) = ManagedPtr PixbufFormat
p

foreign import ccall "gdk_pixbuf_format_get_type" c_gdk_pixbuf_format_get_type :: 
    IO GType

type instance O.ParentTypes PixbufFormat = '[]
instance O.HasParentTypes PixbufFormat

instance B.Types.TypedObject PixbufFormat where
    glibType :: IO GType
glibType = IO GType
c_gdk_pixbuf_format_get_type

instance B.Types.GBoxed PixbufFormat

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


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

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

foreign import ccall "gdk_pixbuf_format_copy" gdk_pixbuf_format_copy :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO (Ptr PixbufFormat)

-- | Creates a copy of /@format@/
-- 
-- /Since: 2.22/
pixbufFormatCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m PixbufFormat
    -- ^ __Returns:__ the newly allocated copy of a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'. Use
    --   'GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatFree' to free the resources when done
pixbufFormatCopy :: PixbufFormat -> m PixbufFormat
pixbufFormatCopy PixbufFormat
format = IO PixbufFormat -> m PixbufFormat
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PixbufFormat -> m PixbufFormat)
-> IO PixbufFormat -> m PixbufFormat
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    Ptr PixbufFormat
result <- Ptr PixbufFormat -> IO (Ptr PixbufFormat)
gdk_pixbuf_format_copy Ptr PixbufFormat
format'
    Text -> Ptr PixbufFormat -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufFormatCopy" Ptr PixbufFormat
result
    PixbufFormat
result' <- ((ManagedPtr PixbufFormat -> PixbufFormat)
-> Ptr PixbufFormat -> IO PixbufFormat
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PixbufFormat -> PixbufFormat
PixbufFormat) Ptr PixbufFormat
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    PixbufFormat -> IO PixbufFormat
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufFormat
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatCopyMethodInfo
instance (signature ~ (m PixbufFormat), MonadIO m) => O.MethodInfo PixbufFormatCopyMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatCopy

#endif

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

foreign import ccall "gdk_pixbuf_format_free" gdk_pixbuf_format_free :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO ()

-- | Frees the resources allocated when copying a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
-- using 'GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatCopy'
-- 
-- /Since: 2.22/
pixbufFormatFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m ()
pixbufFormatFree :: PixbufFormat -> m ()
pixbufFormatFree PixbufFormat
format = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    Ptr PixbufFormat -> IO ()
gdk_pixbuf_format_free Ptr PixbufFormat
format'
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PixbufFormatFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo PixbufFormatFreeMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatFree

#endif

-- method PixbufFormat::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , 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 "gdk_pixbuf_format_get_description" gdk_pixbuf_format_get_description :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO CString

-- | Returns a description of the format.
-- 
-- /Since: 2.2/
pixbufFormatGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m T.Text
    -- ^ __Returns:__ a description of the format.
pixbufFormatGetDescription :: PixbufFormat -> m Text
pixbufFormatGetDescription PixbufFormat
format = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CString
result <- Ptr PixbufFormat -> IO CString
gdk_pixbuf_format_get_description Ptr PixbufFormat
format'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufFormatGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo PixbufFormatGetDescriptionMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetDescription

#endif

-- method PixbufFormat::get_extensions
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , 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 "gdk_pixbuf_format_get_extensions" gdk_pixbuf_format_get_extensions :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO (Ptr CString)

-- | Returns the filename extensions typically used for files in the
-- given format.
-- 
-- /Since: 2.2/
pixbufFormatGetExtensions ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of filename extensions which must be
    -- freed with 'GI.GLib.Functions.strfreev' when it is no longer needed.
pixbufFormatGetExtensions :: PixbufFormat -> m [Text]
pixbufFormatGetExtensions PixbufFormat
format = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    Ptr CString
result <- Ptr PixbufFormat -> IO (Ptr CString)
gdk_pixbuf_format_get_extensions Ptr PixbufFormat
format'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufFormatGetExtensions" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

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

#endif

-- method PixbufFormat::get_license
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , 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 "gdk_pixbuf_format_get_license" gdk_pixbuf_format_get_license :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO CString

-- | Returns information about the license of the image loader for the format. The
-- returned string should be a shorthand for a wellknown license, e.g. \"LGPL\",
-- \"GPL\", \"QPL\", \"GPL\/QPL\", or \"other\" to indicate some other license.  This
-- string should be freed with 'GI.GLib.Functions.free' when it\'s no longer needed.
-- 
-- /Since: 2.6/
pixbufFormatGetLicense ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m T.Text
    -- ^ __Returns:__ a string describing the license of /@format@/.
pixbufFormatGetLicense :: PixbufFormat -> m Text
pixbufFormatGetLicense PixbufFormat
format = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CString
result <- Ptr PixbufFormat -> IO CString
gdk_pixbuf_format_get_license Ptr PixbufFormat
format'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufFormatGetLicense" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatGetLicenseMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo PixbufFormatGetLicenseMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetLicense

#endif

-- method PixbufFormat::get_mime_types
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , 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 "gdk_pixbuf_format_get_mime_types" gdk_pixbuf_format_get_mime_types :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO (Ptr CString)

-- | Returns the mime types supported by the format.
-- 
-- /Since: 2.2/
pixbufFormatGetMimeTypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of mime types which must be freed with
    -- 'GI.GLib.Functions.strfreev' when it is no longer needed.
pixbufFormatGetMimeTypes :: PixbufFormat -> m [Text]
pixbufFormatGetMimeTypes PixbufFormat
format = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    Ptr CString
result <- Ptr PixbufFormat -> IO (Ptr CString)
gdk_pixbuf_format_get_mime_types Ptr PixbufFormat
format'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufFormatGetMimeTypes" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

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

#endif

-- method PixbufFormat::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , 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 "gdk_pixbuf_format_get_name" gdk_pixbuf_format_get_name :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO CString

-- | Returns the name of the format.
-- 
-- /Since: 2.2/
pixbufFormatGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m T.Text
    -- ^ __Returns:__ the name of the format.
pixbufFormatGetName :: PixbufFormat -> m Text
pixbufFormatGetName PixbufFormat
format = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CString
result <- Ptr PixbufFormat -> IO CString
gdk_pixbuf_format_get_name Ptr PixbufFormat
format'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"pixbufFormatGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo PixbufFormatGetNameMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetName

#endif

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

foreign import ccall "gdk_pixbuf_format_is_disabled" gdk_pixbuf_format_is_disabled :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO CInt

-- | Returns whether this image format is disabled. See
-- 'GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatSetDisabled'.
-- 
-- /Since: 2.6/
pixbufFormatIsDisabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m Bool
    -- ^ __Returns:__ whether this image format is disabled.
pixbufFormatIsDisabled :: PixbufFormat -> m Bool
pixbufFormatIsDisabled PixbufFormat
format = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CInt
result <- Ptr PixbufFormat -> IO CInt
gdk_pixbuf_format_is_disabled Ptr PixbufFormat
format'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatIsDisabledMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo PixbufFormatIsDisabledMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsDisabled

#endif

-- method PixbufFormat::is_save_option_supported
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option_key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of an option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixbuf_format_is_save_option_supported" gdk_pixbuf_format_is_save_option_supported :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    CString ->                              -- option_key : TBasicType TUTF8
    IO CInt

-- | Returns 'P.True' if the save option specified by /@optionKey@/ is supported when
-- saving a pixbuf using the module implementing /@format@/.
-- See @/gdk_pixbuf_save()/@ for more information about option keys.
-- 
-- /Since: 2.36/
pixbufFormatIsSaveOptionSupported ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> T.Text
    -- ^ /@optionKey@/: the name of an option
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the specified option is supported
pixbufFormatIsSaveOptionSupported :: PixbufFormat -> Text -> m Bool
pixbufFormatIsSaveOptionSupported PixbufFormat
format Text
optionKey = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CString
optionKey' <- Text -> IO CString
textToCString Text
optionKey
    CInt
result <- Ptr PixbufFormat -> CString -> IO CInt
gdk_pixbuf_format_is_save_option_supported Ptr PixbufFormat
format' CString
optionKey'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionKey'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatIsSaveOptionSupportedMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.MethodInfo PixbufFormatIsSaveOptionSupportedMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsSaveOptionSupported

#endif

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

foreign import ccall "gdk_pixbuf_format_is_scalable" gdk_pixbuf_format_is_scalable :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO CInt

-- | Returns whether this image format is scalable. If a file is in a
-- scalable format, it is preferable to load it at the desired size,
-- rather than loading it at the default size and scaling the
-- resulting pixbuf to the desired size.
-- 
-- /Since: 2.6/
pixbufFormatIsScalable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m Bool
    -- ^ __Returns:__ whether this image format is scalable.
pixbufFormatIsScalable :: PixbufFormat -> m Bool
pixbufFormatIsScalable PixbufFormat
format = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CInt
result <- Ptr PixbufFormat -> IO CInt
gdk_pixbuf_format_is_scalable Ptr PixbufFormat
format'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatIsScalableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo PixbufFormatIsScalableMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsScalable

#endif

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

foreign import ccall "gdk_pixbuf_format_is_writable" gdk_pixbuf_format_is_writable :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO CInt

-- | Returns whether pixbufs can be saved in the given format.
-- 
-- /Since: 2.2/
pixbufFormatIsWritable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> m Bool
    -- ^ __Returns:__ whether pixbufs can be saved in the given format.
pixbufFormatIsWritable :: PixbufFormat -> m Bool
pixbufFormatIsWritable PixbufFormat
format = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    CInt
result <- Ptr PixbufFormat -> IO CInt
gdk_pixbuf_format_is_writable Ptr PixbufFormat
format'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PixbufFormatIsWritableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo PixbufFormatIsWritableMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsWritable

#endif

-- method PixbufFormat::set_disabled
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "format"
--           , argType =
--               TInterface Name { namespace = "GdkPixbuf" , name = "PixbufFormat" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkPixbufFormat" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "disabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to disable the format @format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_pixbuf_format_set_disabled" gdk_pixbuf_format_set_disabled :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    CInt ->                                 -- disabled : TBasicType TBoolean
    IO ()

-- | Disables or enables an image format. If a format is disabled,
-- gdk-pixbuf won\'t use the image loader for this format to load
-- images. Applications can use this to avoid using image loaders
-- with an inappropriate license, see 'GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatGetLicense'.
-- 
-- /Since: 2.6/
pixbufFormatSetDisabled ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a t'GI.GdkPixbuf.Structs.PixbufFormat.PixbufFormat'
    -> Bool
    -- ^ /@disabled@/: 'P.True' to disable the format /@format@/
    -> m ()
pixbufFormatSetDisabled :: PixbufFormat -> Bool -> m ()
pixbufFormatSetDisabled PixbufFormat
format Bool
disabled = 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 PixbufFormat
format' <- PixbufFormat -> IO (Ptr PixbufFormat)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr PixbufFormat
format
    let disabled' :: CInt
disabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
disabled
    Ptr PixbufFormat -> CInt -> IO ()
gdk_pixbuf_format_set_disabled Ptr PixbufFormat
format' CInt
disabled'
    PixbufFormat -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr PixbufFormat
format
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PixbufFormatSetDisabledMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo PixbufFormatSetDisabledMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatSetDisabled

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePixbufFormatMethod (t :: Symbol) (o :: *) :: * where
    ResolvePixbufFormatMethod "copy" o = PixbufFormatCopyMethodInfo
    ResolvePixbufFormatMethod "free" o = PixbufFormatFreeMethodInfo
    ResolvePixbufFormatMethod "isDisabled" o = PixbufFormatIsDisabledMethodInfo
    ResolvePixbufFormatMethod "isSaveOptionSupported" o = PixbufFormatIsSaveOptionSupportedMethodInfo
    ResolvePixbufFormatMethod "isScalable" o = PixbufFormatIsScalableMethodInfo
    ResolvePixbufFormatMethod "isWritable" o = PixbufFormatIsWritableMethodInfo
    ResolvePixbufFormatMethod "getDescription" o = PixbufFormatGetDescriptionMethodInfo
    ResolvePixbufFormatMethod "getExtensions" o = PixbufFormatGetExtensionsMethodInfo
    ResolvePixbufFormatMethod "getLicense" o = PixbufFormatGetLicenseMethodInfo
    ResolvePixbufFormatMethod "getMimeTypes" o = PixbufFormatGetMimeTypesMethodInfo
    ResolvePixbufFormatMethod "getName" o = PixbufFormatGetNameMethodInfo
    ResolvePixbufFormatMethod "setDisabled" o = PixbufFormatSetDisabledMethodInfo
    ResolvePixbufFormatMethod l o = O.MethodResolutionFailed l o

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

#endif