{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GdkPixbufFormat@ contains information about the image format accepted
-- by a module.
-- 
-- Only modules should access the fields directly, applications should
-- use the @gdk_pixbuf_format_*@ family of functions.
-- 
-- /Since: 2.2/

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

module GI.GdkPixbuf.Structs.PixbufFormat
    ( 

-- * Exported types
    PixbufFormat(..)                        ,
    newZeroPixbufFormat                     ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [copy]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:copy"), [free]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:free"), [isDisabled]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:isDisabled"), [isSaveOptionSupported]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:isSaveOptionSupported"), [isScalable]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:isScalable"), [isWritable]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:isWritable").
-- 
-- ==== Getters
-- [getDescription]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:getDescription"), [getExtensions]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:getExtensions"), [getLicense]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:getLicense"), [getMimeTypes]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:getMimeTypes"), [getName]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:getName").
-- 
-- ==== Setters
-- [setDisabled]("GI.GdkPixbuf.Structs.PixbufFormat#g:method:setDisabled").

#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                 ,




 -- * Properties


-- ** description #attr:description#
-- | a description of the image format

    clearPixbufFormatDescription            ,
    getPixbufFormatDescription              ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_description                ,
#endif
    setPixbufFormatDescription              ,


-- ** disabled #attr:disabled#
-- | a boolean determining whether the loader is disabled\`

    getPixbufFormatDisabled                 ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_disabled                   ,
#endif
    setPixbufFormatDisabled                 ,


-- ** domain #attr:domain#
-- | the message domain for the @description@

    clearPixbufFormatDomain                 ,
    getPixbufFormatDomain                   ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_domain                     ,
#endif
    setPixbufFormatDomain                   ,


-- ** extensions #attr:extensions#
-- | typical filename extensions for the
--   image format

    clearPixbufFormatExtensions             ,
    getPixbufFormatExtensions               ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_extensions                 ,
#endif
    setPixbufFormatExtensions               ,


-- ** flags #attr:flags#
-- | a combination of @GdkPixbufFormatFlags@

    getPixbufFormatFlags                    ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_flags                      ,
#endif
    setPixbufFormatFlags                    ,


-- ** license #attr:license#
-- | a string containing license information, typically set to
--   shorthands like \"GPL\", \"LGPL\", etc.

    clearPixbufFormatLicense                ,
    getPixbufFormatLicense                  ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_license                    ,
#endif
    setPixbufFormatLicense                  ,


-- ** mimeTypes #attr:mimeTypes#
-- | the MIME types for the image format

    clearPixbufFormatMimeTypes              ,
    getPixbufFormatMimeTypes                ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_mimeTypes                  ,
#endif
    setPixbufFormatMimeTypes                ,


-- ** name #attr:name#
-- | the name of the image format

    clearPixbufFormatName                   ,
    getPixbufFormatName                     ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_name                       ,
#endif
    setPixbufFormatName                     ,


-- ** signature #attr:signature#
-- | the signature of the module

    clearPixbufFormatSignature              ,
    getPixbufFormatSignature                ,
#if defined(ENABLE_OVERLOADING)
    pixbufFormat_signature                  ,
#endif
    setPixbufFormatSignature                ,




    ) 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.GArray as B.GArray
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
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.GdkPixbuf.Structs.PixbufModulePattern as GdkPixbuf.PixbufModulePattern

-- | 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'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe PixbufFormat) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_pixbuf_format_get_type
    gvalueSet_ :: Ptr GValue -> Maybe PixbufFormat -> IO ()
gvalueSet_ Ptr GValue
gv Maybe PixbufFormat
P.Nothing = Ptr GValue -> Ptr PixbufFormat -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr PixbufFormat
forall a. Ptr a
FP.nullPtr :: FP.Ptr PixbufFormat)
    gvalueSet_ Ptr GValue
gv (P.Just PixbufFormat
obj) = PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr PixbufFormat
obj (Ptr GValue -> Ptr PixbufFormat -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe PixbufFormat)
gvalueGet_ Ptr GValue
gv = do
        Ptr PixbufFormat
ptr <- Ptr GValue -> IO (Ptr PixbufFormat)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr PixbufFormat)
        if Ptr PixbufFormat
ptr Ptr PixbufFormat -> Ptr PixbufFormat -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr PixbufFormat
forall a. Ptr a
FP.nullPtr
        then PixbufFormat -> Maybe PixbufFormat
forall a. a -> Maybe a
P.Just (PixbufFormat -> Maybe PixbufFormat)
-> IO PixbufFormat -> IO (Maybe PixbufFormat)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe PixbufFormat -> IO (Maybe PixbufFormat)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PixbufFormat
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `PixbufFormat` struct initialized to zero.
newZeroPixbufFormat :: MonadIO m => m PixbufFormat
newZeroPixbufFormat :: forall (m :: * -> *). MonadIO m => m PixbufFormat
newZeroPixbufFormat = 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
$ Int -> IO (Ptr PixbufFormat)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
64 IO (Ptr PixbufFormat)
-> (Ptr PixbufFormat -> IO PixbufFormat) -> IO PixbufFormat
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr PixbufFormat -> PixbufFormat)
-> Ptr PixbufFormat -> IO PixbufFormat
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr PixbufFormat -> PixbufFormat
PixbufFormat

instance tag ~ 'AttrSet => Constructible PixbufFormat tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr PixbufFormat -> PixbufFormat)
-> [AttrOp PixbufFormat tag] -> m PixbufFormat
new ManagedPtr PixbufFormat -> PixbufFormat
_ [AttrOp PixbufFormat tag]
attrs = do
        PixbufFormat
o <- m PixbufFormat
forall (m :: * -> *). MonadIO m => m PixbufFormat
newZeroPixbufFormat
        PixbufFormat -> [AttrOp PixbufFormat 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set PixbufFormat
o [AttrOp PixbufFormat tag]
[AttrOp PixbufFormat 'AttrSet]
attrs
        PixbufFormat -> m PixbufFormat
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufFormat
o


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #name
-- @
getPixbufFormatName :: MonadIO m => PixbufFormat -> m (Maybe T.Text)
getPixbufFormatName :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m (Maybe Text)
getPixbufFormatName PixbufFormat
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #name 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatName :: MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatName :: forall (m :: * -> *). MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatName PixbufFormat
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearPixbufFormatName :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatName :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatName PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatNameFieldInfo
instance AttrInfo PixbufFormatNameFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatNameFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint PixbufFormatNameFieldInfo = (~)CString
    type AttrTransferType PixbufFormatNameFieldInfo = CString
    type AttrGetType PixbufFormatNameFieldInfo = Maybe T.Text
    type AttrLabel PixbufFormatNameFieldInfo = "name"
    type AttrOrigin PixbufFormatNameFieldInfo = PixbufFormat
    attrGet = getPixbufFormatName
    attrSet = setPixbufFormatName
    attrConstruct = undefined
    attrClear = clearPixbufFormatName
    attrTransfer _ v = do
        return v

pixbufFormat_name :: AttrLabelProxy "name"
pixbufFormat_name = AttrLabelProxy

#endif


-- | Get the value of the “@signature@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #signature
-- @
getPixbufFormatSignature :: MonadIO m => PixbufFormat -> m (Maybe GdkPixbuf.PixbufModulePattern.PixbufModulePattern)
getPixbufFormatSignature :: forall (m :: * -> *).
MonadIO m =>
PixbufFormat -> m (Maybe PixbufModulePattern)
getPixbufFormatSignature PixbufFormat
s = IO (Maybe PixbufModulePattern) -> m (Maybe PixbufModulePattern)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PixbufModulePattern) -> m (Maybe PixbufModulePattern))
-> IO (Maybe PixbufModulePattern) -> m (Maybe PixbufModulePattern)
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe PixbufModulePattern))
-> IO (Maybe PixbufModulePattern)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe PixbufModulePattern))
 -> IO (Maybe PixbufModulePattern))
-> (Ptr PixbufFormat -> IO (Maybe PixbufModulePattern))
-> IO (Maybe PixbufModulePattern)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr PixbufModulePattern
val <- Ptr (Ptr PixbufModulePattern) -> IO (Ptr PixbufModulePattern)
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr PixbufModulePattern)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern)
    Maybe PixbufModulePattern
result <- Ptr PixbufModulePattern
-> (Ptr PixbufModulePattern -> IO PixbufModulePattern)
-> IO (Maybe PixbufModulePattern)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr PixbufModulePattern
val ((Ptr PixbufModulePattern -> IO PixbufModulePattern)
 -> IO (Maybe PixbufModulePattern))
-> (Ptr PixbufModulePattern -> IO PixbufModulePattern)
-> IO (Maybe PixbufModulePattern)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufModulePattern
val' -> do
        PixbufModulePattern
val'' <- ((ManagedPtr PixbufModulePattern -> PixbufModulePattern)
-> Ptr PixbufModulePattern -> IO PixbufModulePattern
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr PixbufModulePattern -> PixbufModulePattern
GdkPixbuf.PixbufModulePattern.PixbufModulePattern) Ptr PixbufModulePattern
val'
        PixbufModulePattern -> IO PixbufModulePattern
forall (m :: * -> *) a. Monad m => a -> m a
return PixbufModulePattern
val''
    Maybe PixbufModulePattern -> IO (Maybe PixbufModulePattern)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PixbufModulePattern
result

-- | Set the value of the “@signature@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #signature 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatSignature :: MonadIO m => PixbufFormat -> Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern -> m ()
setPixbufFormatSignature :: forall (m :: * -> *).
MonadIO m =>
PixbufFormat -> Ptr PixbufModulePattern -> m ()
setPixbufFormatSignature PixbufFormat
s Ptr PixbufModulePattern
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr (Ptr PixbufModulePattern) -> Ptr PixbufModulePattern -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr PixbufModulePattern)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr PixbufModulePattern
val :: Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern)

-- | Set the value of the “@signature@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #signature
-- @
clearPixbufFormatSignature :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatSignature :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatSignature PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr (Ptr PixbufModulePattern) -> Ptr PixbufModulePattern -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr PixbufModulePattern)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Ptr PixbufModulePattern
forall a. Ptr a
FP.nullPtr :: Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatSignatureFieldInfo
instance AttrInfo PixbufFormatSignatureFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatSignatureFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatSignatureFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatSignatureFieldInfo = (~) (Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern)
    type AttrTransferTypeConstraint PixbufFormatSignatureFieldInfo = (~)(Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern)
    type AttrTransferType PixbufFormatSignatureFieldInfo = (Ptr GdkPixbuf.PixbufModulePattern.PixbufModulePattern)
    type AttrGetType PixbufFormatSignatureFieldInfo = Maybe GdkPixbuf.PixbufModulePattern.PixbufModulePattern
    type AttrLabel PixbufFormatSignatureFieldInfo = "signature"
    type AttrOrigin PixbufFormatSignatureFieldInfo = PixbufFormat
    attrGet = getPixbufFormatSignature
    attrSet = setPixbufFormatSignature
    attrConstruct = undefined
    attrClear = clearPixbufFormatSignature
    attrTransfer _ v = do
        return v

pixbufFormat_signature :: AttrLabelProxy "signature"
pixbufFormat_signature = AttrLabelProxy

#endif


-- | Get the value of the “@domain@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #domain
-- @
getPixbufFormatDomain :: MonadIO m => PixbufFormat -> m (Maybe T.Text)
getPixbufFormatDomain :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m (Maybe Text)
getPixbufFormatDomain PixbufFormat
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@domain@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #domain 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatDomain :: MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatDomain :: forall (m :: * -> *). MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatDomain PixbufFormat
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
val :: CString)

-- | Set the value of the “@domain@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #domain
-- @
clearPixbufFormatDomain :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatDomain :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatDomain PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatDomainFieldInfo
instance AttrInfo PixbufFormatDomainFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatDomainFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatDomainFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatDomainFieldInfo = (~) CString
    type AttrTransferTypeConstraint PixbufFormatDomainFieldInfo = (~)CString
    type AttrTransferType PixbufFormatDomainFieldInfo = CString
    type AttrGetType PixbufFormatDomainFieldInfo = Maybe T.Text
    type AttrLabel PixbufFormatDomainFieldInfo = "domain"
    type AttrOrigin PixbufFormatDomainFieldInfo = PixbufFormat
    attrGet = getPixbufFormatDomain
    attrSet = setPixbufFormatDomain
    attrConstruct = undefined
    attrClear = clearPixbufFormatDomain
    attrTransfer _ v = do
        return v

pixbufFormat_domain :: AttrLabelProxy "domain"
pixbufFormat_domain = AttrLabelProxy

#endif


-- | Get the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #description
-- @
getPixbufFormatDescription :: MonadIO m => PixbufFormat -> m (Maybe T.Text)
getPixbufFormatDescription :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m (Maybe Text)
getPixbufFormatDescription PixbufFormat
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #description 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatDescription :: MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatDescription :: forall (m :: * -> *). MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatDescription PixbufFormat
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
val :: CString)

-- | Set the value of the “@description@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #description
-- @
clearPixbufFormatDescription :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatDescription :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatDescription PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatDescriptionFieldInfo
instance AttrInfo PixbufFormatDescriptionFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatDescriptionFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatDescriptionFieldInfo = (~) CString
    type AttrTransferTypeConstraint PixbufFormatDescriptionFieldInfo = (~)CString
    type AttrTransferType PixbufFormatDescriptionFieldInfo = CString
    type AttrGetType PixbufFormatDescriptionFieldInfo = Maybe T.Text
    type AttrLabel PixbufFormatDescriptionFieldInfo = "description"
    type AttrOrigin PixbufFormatDescriptionFieldInfo = PixbufFormat
    attrGet = getPixbufFormatDescription
    attrSet = setPixbufFormatDescription
    attrConstruct = undefined
    attrClear = clearPixbufFormatDescription
    attrTransfer _ v = do
        return v

pixbufFormat_description :: AttrLabelProxy "description"
pixbufFormat_description = AttrLabelProxy

#endif


-- | Get the value of the “@mime_types@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #mimeTypes
-- @
getPixbufFormatMimeTypes :: MonadIO m => PixbufFormat -> m (Maybe [T.Text])
getPixbufFormatMimeTypes :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m (Maybe [Text])
getPixbufFormatMimeTypes PixbufFormat
s = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe [Text])) -> IO (Maybe [Text])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe [Text])) -> IO (Maybe [Text]))
-> (Ptr PixbufFormat -> IO (Maybe [Text])) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString
val <- Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr CString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO (Ptr CString)
    Maybe [Text]
result <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr CString
val ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
val' -> do
        [Text]
val'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
val'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
val''
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
result

-- | Set the value of the “@mime_types@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #mimeTypes 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatMimeTypes :: MonadIO m => PixbufFormat -> Ptr CString -> m ()
setPixbufFormatMimeTypes :: forall (m :: * -> *).
MonadIO m =>
PixbufFormat -> Ptr CString -> m ()
setPixbufFormatMimeTypes PixbufFormat
s Ptr CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr (Ptr CString) -> Ptr CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr CString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Ptr CString
val :: Ptr CString)

-- | Set the value of the “@mime_types@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #mimeTypes
-- @
clearPixbufFormatMimeTypes :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatMimeTypes :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatMimeTypes PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr (Ptr CString) -> Ptr CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr CString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (Ptr CString
forall a. Ptr a
FP.nullPtr :: Ptr CString)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatMimeTypesFieldInfo
instance AttrInfo PixbufFormatMimeTypesFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatMimeTypesFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatMimeTypesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatMimeTypesFieldInfo = (~) (Ptr CString)
    type AttrTransferTypeConstraint PixbufFormatMimeTypesFieldInfo = (~)(Ptr CString)
    type AttrTransferType PixbufFormatMimeTypesFieldInfo = (Ptr CString)
    type AttrGetType PixbufFormatMimeTypesFieldInfo = Maybe [T.Text]
    type AttrLabel PixbufFormatMimeTypesFieldInfo = "mime_types"
    type AttrOrigin PixbufFormatMimeTypesFieldInfo = PixbufFormat
    attrGet = getPixbufFormatMimeTypes
    attrSet = setPixbufFormatMimeTypes
    attrConstruct = undefined
    attrClear = clearPixbufFormatMimeTypes
    attrTransfer _ v = do
        return v

pixbufFormat_mimeTypes :: AttrLabelProxy "mimeTypes"
pixbufFormat_mimeTypes = AttrLabelProxy

#endif


-- | Get the value of the “@extensions@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #extensions
-- @
getPixbufFormatExtensions :: MonadIO m => PixbufFormat -> m (Maybe [T.Text])
getPixbufFormatExtensions :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m (Maybe [Text])
getPixbufFormatExtensions PixbufFormat
s = IO (Maybe [Text]) -> m (Maybe [Text])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text]) -> m (Maybe [Text]))
-> IO (Maybe [Text]) -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe [Text])) -> IO (Maybe [Text])
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe [Text])) -> IO (Maybe [Text]))
-> (Ptr PixbufFormat -> IO (Maybe [Text])) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString
val <- Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr CString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO (Ptr CString)
    Maybe [Text]
result <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr CString
val ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr CString
val' -> do
        [Text]
val'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
val'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
val''
    Maybe [Text] -> IO (Maybe [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Text]
result

-- | Set the value of the “@extensions@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #extensions 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatExtensions :: MonadIO m => PixbufFormat -> Ptr CString -> m ()
setPixbufFormatExtensions :: forall (m :: * -> *).
MonadIO m =>
PixbufFormat -> Ptr CString -> m ()
setPixbufFormatExtensions PixbufFormat
s Ptr CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr (Ptr CString) -> Ptr CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr CString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr CString
val :: Ptr CString)

-- | Set the value of the “@extensions@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #extensions
-- @
clearPixbufFormatExtensions :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatExtensions :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatExtensions PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr (Ptr CString) -> Ptr CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr (Ptr CString)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (Ptr CString
forall a. Ptr a
FP.nullPtr :: Ptr CString)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatExtensionsFieldInfo
instance AttrInfo PixbufFormatExtensionsFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatExtensionsFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatExtensionsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatExtensionsFieldInfo = (~) (Ptr CString)
    type AttrTransferTypeConstraint PixbufFormatExtensionsFieldInfo = (~)(Ptr CString)
    type AttrTransferType PixbufFormatExtensionsFieldInfo = (Ptr CString)
    type AttrGetType PixbufFormatExtensionsFieldInfo = Maybe [T.Text]
    type AttrLabel PixbufFormatExtensionsFieldInfo = "extensions"
    type AttrOrigin PixbufFormatExtensionsFieldInfo = PixbufFormat
    attrGet = getPixbufFormatExtensions
    attrSet = setPixbufFormatExtensions
    attrConstruct = undefined
    attrClear = clearPixbufFormatExtensions
    attrTransfer _ v = do
        return v

pixbufFormat_extensions :: AttrLabelProxy "extensions"
pixbufFormat_extensions = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #flags
-- @
getPixbufFormatFlags :: MonadIO m => PixbufFormat -> m Word32
getPixbufFormatFlags :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m Word32
getPixbufFormatFlags PixbufFormat
s = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO Word32) -> IO Word32
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO Word32) -> IO Word32)
-> (Ptr PixbufFormat -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Word32
val <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO Word32
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
val

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatFlags :: MonadIO m => PixbufFormat -> Word32 -> m ()
setPixbufFormatFlags :: forall (m :: * -> *). MonadIO m => PixbufFormat -> Word32 -> m ()
setPixbufFormatFlags PixbufFormat
s Word32
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr Word32
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (Word32
val :: Word32)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatFlagsFieldInfo
instance AttrInfo PixbufFormatFlagsFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatFlagsFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixbufFormatFlagsFieldInfo = (~) Word32
    type AttrTransferTypeConstraint PixbufFormatFlagsFieldInfo = (~)Word32
    type AttrTransferType PixbufFormatFlagsFieldInfo = Word32
    type AttrGetType PixbufFormatFlagsFieldInfo = Word32
    type AttrLabel PixbufFormatFlagsFieldInfo = "flags"
    type AttrOrigin PixbufFormatFlagsFieldInfo = PixbufFormat
    attrGet = getPixbufFormatFlags
    attrSet = setPixbufFormatFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

pixbufFormat_flags :: AttrLabelProxy "flags"
pixbufFormat_flags = AttrLabelProxy

#endif


-- | Get the value of the “@disabled@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #disabled
-- @
getPixbufFormatDisabled :: MonadIO m => PixbufFormat -> m Bool
getPixbufFormatDisabled :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m Bool
getPixbufFormatDisabled PixbufFormat
s = 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
$ PixbufFormat -> (Ptr PixbufFormat -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO Bool) -> IO Bool)
-> (Ptr PixbufFormat -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@disabled@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #disabled 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatDisabled :: MonadIO m => PixbufFormat -> Bool -> m ()
setPixbufFormatDisabled :: forall (m :: * -> *). MonadIO m => PixbufFormat -> Bool -> m ()
setPixbufFormatDisabled PixbufFormat
s Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
52) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatDisabledFieldInfo
instance AttrInfo PixbufFormatDisabledFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatDisabledFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatDisabledFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixbufFormatDisabledFieldInfo = (~) Bool
    type AttrTransferTypeConstraint PixbufFormatDisabledFieldInfo = (~)Bool
    type AttrTransferType PixbufFormatDisabledFieldInfo = Bool
    type AttrGetType PixbufFormatDisabledFieldInfo = Bool
    type AttrLabel PixbufFormatDisabledFieldInfo = "disabled"
    type AttrOrigin PixbufFormatDisabledFieldInfo = PixbufFormat
    attrGet = getPixbufFormatDisabled
    attrSet = setPixbufFormatDisabled
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

pixbufFormat_disabled :: AttrLabelProxy "disabled"
pixbufFormat_disabled = AttrLabelProxy

#endif


-- | Get the value of the “@license@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pixbufFormat #license
-- @
getPixbufFormatLicense :: MonadIO m => PixbufFormat -> m (Maybe T.Text)
getPixbufFormatLicense :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m (Maybe Text)
getPixbufFormatLicense PixbufFormat
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PixbufFormat
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PixbufFormat -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@license@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' pixbufFormat [ #license 'Data.GI.Base.Attributes.:=' value ]
-- @
setPixbufFormatLicense :: MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatLicense :: forall (m :: * -> *). MonadIO m => PixbufFormat -> CString -> m ()
setPixbufFormatLicense PixbufFormat
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (CString
val :: CString)

-- | Set the value of the “@license@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #license
-- @
clearPixbufFormatLicense :: MonadIO m => PixbufFormat -> m ()
clearPixbufFormatLicense :: forall (m :: * -> *). MonadIO m => PixbufFormat -> m ()
clearPixbufFormatLicense PixbufFormat
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufFormat -> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufFormat
s ((Ptr PixbufFormat -> IO ()) -> IO ())
-> (Ptr PixbufFormat -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufFormat
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufFormat
ptr Ptr PixbufFormat -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PixbufFormatLicenseFieldInfo
instance AttrInfo PixbufFormatLicenseFieldInfo where
    type AttrBaseTypeConstraint PixbufFormatLicenseFieldInfo = (~) PixbufFormat
    type AttrAllowedOps PixbufFormatLicenseFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufFormatLicenseFieldInfo = (~) CString
    type AttrTransferTypeConstraint PixbufFormatLicenseFieldInfo = (~)CString
    type AttrTransferType PixbufFormatLicenseFieldInfo = CString
    type AttrGetType PixbufFormatLicenseFieldInfo = Maybe T.Text
    type AttrLabel PixbufFormatLicenseFieldInfo = "license"
    type AttrOrigin PixbufFormatLicenseFieldInfo = PixbufFormat
    attrGet = getPixbufFormatLicense
    attrSet = setPixbufFormatLicense
    attrConstruct = undefined
    attrClear = clearPixbufFormatLicense
    attrTransfer _ v = do
        return v

pixbufFormat_license :: AttrLabelProxy "license"
pixbufFormat_license = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PixbufFormat
type instance O.AttributeList PixbufFormat = PixbufFormatAttributeList
type PixbufFormatAttributeList = ('[ '("name", PixbufFormatNameFieldInfo), '("signature", PixbufFormatSignatureFieldInfo), '("domain", PixbufFormatDomainFieldInfo), '("description", PixbufFormatDescriptionFieldInfo), '("mimeTypes", PixbufFormatMimeTypesFieldInfo), '("extensions", PixbufFormatExtensionsFieldInfo), '("flags", PixbufFormatFlagsFieldInfo), '("disabled", PixbufFormatDisabledFieldInfo), '("license", PixbufFormatLicenseFieldInfo)] :: [(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 pixbuf format" , 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 pixbuf format
    -> m PixbufFormat
    -- ^ __Returns:__ the newly allocated copy of a @GdkPixbufFormat@. Use
    --   'GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatFree' to free the resources when done
pixbufFormatCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatCopyMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatCopy

instance O.OverloadedMethodInfo PixbufFormatCopyMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 pixbuf 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_free" gdk_pixbuf_format_free :: 
    Ptr PixbufFormat ->                     -- format : TInterface (Name {namespace = "GdkPixbuf", name = "PixbufFormat"})
    IO ()

-- | Frees the resources allocated when copying a @GdkPixbufFormat@
-- using 'GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatCopy'
-- 
-- /Since: 2.22/
pixbufFormatFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a pixbuf format
    -> m ()
pixbufFormatFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatFreeMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatFree

instance O.OverloadedMethodInfo PixbufFormatFreeMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m T.Text
    -- ^ __Returns:__ a description of the format.
pixbufFormatGetDescription :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatGetDescriptionMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetDescription

instance O.OverloadedMethodInfo PixbufFormatGetDescriptionMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatGetDescription",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m [T.Text]
    -- ^ __Returns:__ an array of
    --   filename extensions
pixbufFormatGetExtensions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatGetExtensionsMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetExtensions

instance O.OverloadedMethodInfo PixbufFormatGetExtensionsMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatGetExtensions",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 pixbuf format" , 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 well known license, e.g.
-- \"LGPL\", \"GPL\", \"QPL\", \"GPL\/QPL\", or \"other\" to indicate some other license.
-- 
-- /Since: 2.6/
pixbufFormatGetLicense ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    PixbufFormat
    -- ^ /@format@/: a pixbuf format
    -> m T.Text
    -- ^ __Returns:__ a string describing the license of the pixbuf format
pixbufFormatGetLicense :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatGetLicenseMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetLicense

instance O.OverloadedMethodInfo PixbufFormatGetLicenseMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatGetLicense",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m [T.Text]
    -- ^ __Returns:__ an array of mime types
pixbufFormatGetMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatGetMimeTypesMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetMimeTypes

instance O.OverloadedMethodInfo PixbufFormatGetMimeTypesMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatGetMimeTypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m T.Text
    -- ^ __Returns:__ the name of the format.
pixbufFormatGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatGetNameMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatGetName

instance O.OverloadedMethodInfo PixbufFormatGetNameMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m Bool
    -- ^ __Returns:__ whether this image format is disabled.
pixbufFormatIsDisabled :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatIsDisabledMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsDisabled

instance O.OverloadedMethodInfo PixbufFormatIsDisabledMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatIsDisabled",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 pixbuf format" , 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 @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 pixbuf format
    -> T.Text
    -- ^ /@optionKey@/: the name of an option
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the specified option is supported
pixbufFormatIsSaveOptionSupported :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatIsSaveOptionSupportedMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsSaveOptionSupported

instance O.OverloadedMethodInfo PixbufFormatIsSaveOptionSupportedMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatIsSaveOptionSupported",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m Bool
    -- ^ __Returns:__ whether this image format is scalable.
pixbufFormatIsScalable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatIsScalableMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsScalable

instance O.OverloadedMethodInfo PixbufFormatIsScalableMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatIsScalable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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 @GdkPixbufFormat@
    -> m Bool
    -- ^ __Returns:__ whether pixbufs can be saved in the given format.
pixbufFormatIsWritable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatIsWritableMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatIsWritable

instance O.OverloadedMethodInfo PixbufFormatIsWritableMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatIsWritable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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, GdkPixbuf 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 @GdkPixbufFormat@
    -> Bool
    -- ^ /@disabled@/: @TRUE@ to disable the format /@format@/
    -> m ()
pixbufFormatSetDisabled :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
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.OverloadedMethod PixbufFormatSetDisabledMethodInfo PixbufFormat signature where
    overloadedMethod = pixbufFormatSetDisabled

instance O.OverloadedMethodInfo PixbufFormatSetDisabledMethodInfo PixbufFormat where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.GdkPixbuf.Structs.PixbufFormat.pixbufFormatSetDisabled",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdkpixbuf-2.0.26/docs/GI-GdkPixbuf-Structs-PixbufFormat.html#v: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.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePixbufFormatMethod t PixbufFormat, O.OverloadedMethod info PixbufFormat p, R.HasField t PixbufFormat p) => R.HasField t PixbufFormat p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePixbufFormatMethod t PixbufFormat, O.OverloadedMethodInfo info PixbufFormat) => OL.IsLabel t (O.MethodProxy info PixbufFormat) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif