{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GdkDmabufFormats@ struct provides information about
-- supported DMA buffer formats.
-- 
-- You can query whether a given format is supported with
-- 'GI.Gdk.Structs.DmabufFormats.dmabufFormatsContains' and you can iterate
-- over the list of all supported formats with
-- 'GI.Gdk.Structs.DmabufFormats.dmabufFormatsGetNFormats' and
-- 'GI.Gdk.Structs.DmabufFormats.dmabufFormatsGetFormat'.
-- 
-- The list of supported formats is sorted by preference,
-- with the best formats coming first.
-- 
-- The list may contains (format, modifier) pairs where the modifier
-- is @DMA_FORMAT_MOD_INVALID@, indicating that **_implicit modifiers_**
-- may be used with this format.
-- 
-- See t'GI.Gdk.Objects.DmabufTextureBuilder.DmabufTextureBuilder' for more information
-- about DMA buffers.
-- 
-- Note that DMA buffers only exist on Linux.
-- 
-- /Since: 4.14/

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

module GI.Gdk.Structs.DmabufFormats
    ( 

-- * Exported types
    DmabufFormats(..)                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [contains]("GI.Gdk.Structs.DmabufFormats#g:method:contains"), [equal]("GI.Gdk.Structs.DmabufFormats#g:method:equal"), [ref]("GI.Gdk.Structs.DmabufFormats#g:method:ref"), [unref]("GI.Gdk.Structs.DmabufFormats#g:method:unref").
-- 
-- ==== Getters
-- [getFormat]("GI.Gdk.Structs.DmabufFormats#g:method:getFormat"), [getNFormats]("GI.Gdk.Structs.DmabufFormats#g:method:getNFormats").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveDmabufFormatsMethod              ,
#endif

-- ** contains #method:contains#

#if defined(ENABLE_OVERLOADING)
    DmabufFormatsContainsMethodInfo         ,
#endif
    dmabufFormatsContains                   ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    DmabufFormatsEqualMethodInfo            ,
#endif
    dmabufFormatsEqual                      ,


-- ** getFormat #method:getFormat#

#if defined(ENABLE_OVERLOADING)
    DmabufFormatsGetFormatMethodInfo        ,
#endif
    dmabufFormatsGetFormat                  ,


-- ** getNFormats #method:getNFormats#

#if defined(ENABLE_OVERLOADING)
    DmabufFormatsGetNFormatsMethodInfo      ,
#endif
    dmabufFormatsGetNFormats                ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    DmabufFormatsRefMethodInfo              ,
#endif
    dmabufFormatsRef                        ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    DmabufFormatsUnrefMethodInfo            ,
#endif
    dmabufFormatsUnref                      ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)

#else

#endif

-- | Memory-managed wrapper type.
newtype DmabufFormats = DmabufFormats (SP.ManagedPtr DmabufFormats)
    deriving (DmabufFormats -> DmabufFormats -> Bool
(DmabufFormats -> DmabufFormats -> Bool)
-> (DmabufFormats -> DmabufFormats -> Bool) -> Eq DmabufFormats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DmabufFormats -> DmabufFormats -> Bool
== :: DmabufFormats -> DmabufFormats -> Bool
$c/= :: DmabufFormats -> DmabufFormats -> Bool
/= :: DmabufFormats -> DmabufFormats -> Bool
Eq)

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

foreign import ccall "gdk_dmabuf_formats_get_type" c_gdk_dmabuf_formats_get_type :: 
    IO GType

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

instance B.Types.TypedObject DmabufFormats where
    glibType :: IO GType
glibType = IO GType
c_gdk_dmabuf_formats_get_type

instance B.Types.GBoxed DmabufFormats

-- | Convert 'DmabufFormats' 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 DmabufFormats) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gdk_dmabuf_formats_get_type
    gvalueSet_ :: Ptr GValue -> Maybe DmabufFormats -> IO ()
gvalueSet_ Ptr GValue
gv Maybe DmabufFormats
P.Nothing = Ptr GValue -> Ptr DmabufFormats -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr DmabufFormats
forall a. Ptr a
FP.nullPtr :: FP.Ptr DmabufFormats)
    gvalueSet_ Ptr GValue
gv (P.Just DmabufFormats
obj) = DmabufFormats -> (Ptr DmabufFormats -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DmabufFormats
obj (Ptr GValue -> Ptr DmabufFormats -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe DmabufFormats)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr DmabufFormats)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr DmabufFormats)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed DmabufFormats ptr
        else return P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DmabufFormats
type instance O.AttributeList DmabufFormats = DmabufFormatsAttributeList
type DmabufFormatsAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method DmabufFormats::contains
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DmabufFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkDmabufFormats`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fourcc"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a format code" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifier"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a format modifier" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_dmabuf_formats_contains" gdk_dmabuf_formats_contains :: 
    Ptr DmabufFormats ->                    -- formats : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    Word32 ->                               -- fourcc : TBasicType TUInt32
    Word64 ->                               -- modifier : TBasicType TUInt64
    IO CInt

-- | Returns whether a given format is contained in /@formats@/.
-- 
-- /Since: 4.14/
dmabufFormatsContains ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DmabufFormats
    -- ^ /@formats@/: a @GdkDmabufFormats@
    -> Word32
    -- ^ /@fourcc@/: a format code
    -> Word64
    -- ^ /@modifier@/: a format modifier
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the format specified by the arguments
    --   is part of /@formats@/
dmabufFormatsContains :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DmabufFormats -> Word32 -> Word64 -> m Bool
dmabufFormatsContains DmabufFormats
formats Word32
fourcc Word64
modifier = IO Bool -> m Bool
forall a. IO a -> m a
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
    formats' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
formats
    result <- gdk_dmabuf_formats_contains formats' fourcc modifier
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr formats
    return result'

#if defined(ENABLE_OVERLOADING)
data DmabufFormatsContainsMethodInfo
instance (signature ~ (Word32 -> Word64 -> m Bool), MonadIO m) => O.OverloadedMethod DmabufFormatsContainsMethodInfo DmabufFormats signature where
    overloadedMethod = dmabufFormatsContains

instance O.OverloadedMethodInfo DmabufFormatsContainsMethodInfo DmabufFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.DmabufFormats.dmabufFormatsContains",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-DmabufFormats.html#v:dmabufFormatsContains"
        })


#endif

-- method DmabufFormats::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats1"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DmabufFormats" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkDmabufFormats`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "formats2"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DmabufFormats" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "another `GdkDmabufFormats`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_dmabuf_formats_equal" gdk_dmabuf_formats_equal :: 
    Ptr DmabufFormats ->                    -- formats1 : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    Ptr DmabufFormats ->                    -- formats2 : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    IO CInt

-- | Returns whether /@formats1@/ and /@formats2@/ contain the
-- same dmabuf formats, in the same order.
-- 
-- /Since: 4.14/
dmabufFormatsEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (DmabufFormats)
    -- ^ /@formats1@/: a @GdkDmabufFormats@
    -> Maybe (DmabufFormats)
    -- ^ /@formats2@/: another @GdkDmabufFormats@
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@formats1@/ and /@formats2@/ are equal
dmabufFormatsEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe DmabufFormats -> Maybe DmabufFormats -> m Bool
dmabufFormatsEqual Maybe DmabufFormats
formats1 Maybe DmabufFormats
formats2 = IO Bool -> m Bool
forall a. IO a -> m a
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
    maybeFormats1 <- case Maybe DmabufFormats
formats1 of
        Maybe DmabufFormats
Nothing -> Ptr DmabufFormats -> IO (Ptr DmabufFormats)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DmabufFormats
forall a. Ptr a
FP.nullPtr
        Just DmabufFormats
jFormats1 -> do
            jFormats1' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
jFormats1
            return jFormats1'
    maybeFormats2 <- case formats2 of
        Maybe DmabufFormats
Nothing -> Ptr DmabufFormats -> IO (Ptr DmabufFormats)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr DmabufFormats
forall a. Ptr a
FP.nullPtr
        Just DmabufFormats
jFormats2 -> do
            jFormats2' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
jFormats2
            return jFormats2'
    result <- gdk_dmabuf_formats_equal maybeFormats1 maybeFormats2
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    whenJust formats1 touchManagedPtr
    whenJust formats2 touchManagedPtr
    return result'

#if defined(ENABLE_OVERLOADING)
data DmabufFormatsEqualMethodInfo
instance (signature ~ (Maybe (DmabufFormats) -> m Bool), MonadIO m) => O.OverloadedMethod DmabufFormatsEqualMethodInfo DmabufFormats signature where
    overloadedMethod i = dmabufFormatsEqual (Just i)

instance O.OverloadedMethodInfo DmabufFormatsEqualMethodInfo DmabufFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.DmabufFormats.dmabufFormatsEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-DmabufFormats.html#v:dmabufFormatsEqual"
        })


#endif

-- method DmabufFormats::get_format
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DmabufFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkDmabufFormats`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "idx"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the index of the format to return"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fourcc"
--           , argType = TBasicType TUInt32
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the format code"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "modifier"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the format modifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_dmabuf_formats_get_format" gdk_dmabuf_formats_get_format :: 
    Ptr DmabufFormats ->                    -- formats : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    FCT.CSize ->                            -- idx : TBasicType TSize
    Ptr Word32 ->                           -- fourcc : TBasicType TUInt32
    Ptr Word64 ->                           -- modifier : TBasicType TUInt64
    IO ()

-- | Gets the fourcc code and modifier for a format
-- that is contained in /@formats@/.
-- 
-- /Since: 4.14/
dmabufFormatsGetFormat ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DmabufFormats
    -- ^ /@formats@/: a @GdkDmabufFormats@
    -> FCT.CSize
    -- ^ /@idx@/: the index of the format to return
    -> m ((Word32, Word64))
dmabufFormatsGetFormat :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DmabufFormats -> CSize -> m (Word32, Word64)
dmabufFormatsGetFormat DmabufFormats
formats CSize
idx = IO (Word32, Word64) -> m (Word32, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word32, Word64) -> m (Word32, Word64))
-> IO (Word32, Word64) -> m (Word32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    formats' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
formats
    fourcc <- allocMem :: IO (Ptr Word32)
    modifier <- allocMem :: IO (Ptr Word64)
    gdk_dmabuf_formats_get_format formats' idx fourcc modifier
    fourcc' <- peek fourcc
    modifier' <- peek modifier
    touchManagedPtr formats
    freeMem fourcc
    freeMem modifier
    return (fourcc', modifier')

#if defined(ENABLE_OVERLOADING)
data DmabufFormatsGetFormatMethodInfo
instance (signature ~ (FCT.CSize -> m ((Word32, Word64))), MonadIO m) => O.OverloadedMethod DmabufFormatsGetFormatMethodInfo DmabufFormats signature where
    overloadedMethod = dmabufFormatsGetFormat

instance O.OverloadedMethodInfo DmabufFormatsGetFormatMethodInfo DmabufFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.DmabufFormats.dmabufFormatsGetFormat",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-DmabufFormats.html#v:dmabufFormatsGetFormat"
        })


#endif

-- method DmabufFormats::get_n_formats
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "DmabufFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkDmabufFormats`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TSize)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_dmabuf_formats_get_n_formats" gdk_dmabuf_formats_get_n_formats :: 
    Ptr DmabufFormats ->                    -- formats : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    IO FCT.CSize

-- | Returns the number of formats that the /@formats@/ object
-- contains.
-- 
-- Note that DMA buffers are a Linux concept, so on other
-- platforms, 'GI.Gdk.Structs.DmabufFormats.dmabufFormatsGetNFormats' will
-- always return zero.
-- 
-- /Since: 4.14/
dmabufFormatsGetNFormats ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DmabufFormats
    -- ^ /@formats@/: a @GdkDmabufFormats@
    -> m FCT.CSize
    -- ^ __Returns:__ the number of formats
dmabufFormatsGetNFormats :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DmabufFormats -> m CSize
dmabufFormatsGetNFormats DmabufFormats
formats = IO CSize -> m CSize
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CSize -> m CSize) -> IO CSize -> m CSize
forall a b. (a -> b) -> a -> b
$ do
    formats' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
formats
    result <- gdk_dmabuf_formats_get_n_formats formats'
    touchManagedPtr formats
    return result

#if defined(ENABLE_OVERLOADING)
data DmabufFormatsGetNFormatsMethodInfo
instance (signature ~ (m FCT.CSize), MonadIO m) => O.OverloadedMethod DmabufFormatsGetNFormatsMethodInfo DmabufFormats signature where
    overloadedMethod = dmabufFormatsGetNFormats

instance O.OverloadedMethodInfo DmabufFormatsGetNFormatsMethodInfo DmabufFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.DmabufFormats.dmabufFormatsGetNFormats",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-DmabufFormats.html#v:dmabufFormatsGetNFormats"
        })


#endif

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

foreign import ccall "gdk_dmabuf_formats_ref" gdk_dmabuf_formats_ref :: 
    Ptr DmabufFormats ->                    -- formats : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    IO (Ptr DmabufFormats)

-- | Increases the reference count of /@formats@/.
-- 
-- /Since: 4.14/
dmabufFormatsRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DmabufFormats
    -- ^ /@formats@/: a @GdkDmabufFormats@
    -> m DmabufFormats
    -- ^ __Returns:__ the passed-in object
dmabufFormatsRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DmabufFormats -> m DmabufFormats
dmabufFormatsRef DmabufFormats
formats = IO DmabufFormats -> m DmabufFormats
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DmabufFormats -> m DmabufFormats)
-> IO DmabufFormats -> m DmabufFormats
forall a b. (a -> b) -> a -> b
$ do
    formats' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
formats
    result <- gdk_dmabuf_formats_ref formats'
    checkUnexpectedReturnNULL "dmabufFormatsRef" result
    result' <- (wrapBoxed DmabufFormats) result
    touchManagedPtr formats
    return result'

#if defined(ENABLE_OVERLOADING)
data DmabufFormatsRefMethodInfo
instance (signature ~ (m DmabufFormats), MonadIO m) => O.OverloadedMethod DmabufFormatsRefMethodInfo DmabufFormats signature where
    overloadedMethod = dmabufFormatsRef

instance O.OverloadedMethodInfo DmabufFormatsRefMethodInfo DmabufFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.DmabufFormats.dmabufFormatsRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-DmabufFormats.html#v:dmabufFormatsRef"
        })


#endif

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

foreign import ccall "gdk_dmabuf_formats_unref" gdk_dmabuf_formats_unref :: 
    Ptr DmabufFormats ->                    -- formats : TInterface (Name {namespace = "Gdk", name = "DmabufFormats"})
    IO ()

-- | Decreases the reference count of /@formats@/.
-- 
-- When the reference count reaches zero,
-- the object is freed.
-- 
-- /Since: 4.14/
dmabufFormatsUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DmabufFormats
    -- ^ /@formats@/: a @GdkDmabufFormats@
    -> m ()
dmabufFormatsUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DmabufFormats -> m ()
dmabufFormatsUnref DmabufFormats
formats = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    formats' <- DmabufFormats -> IO (Ptr DmabufFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DmabufFormats
formats
    gdk_dmabuf_formats_unref formats'
    touchManagedPtr formats
    return ()

#if defined(ENABLE_OVERLOADING)
data DmabufFormatsUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod DmabufFormatsUnrefMethodInfo DmabufFormats signature where
    overloadedMethod = dmabufFormatsUnref

instance O.OverloadedMethodInfo DmabufFormatsUnrefMethodInfo DmabufFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.DmabufFormats.dmabufFormatsUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-DmabufFormats.html#v:dmabufFormatsUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDmabufFormatsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDmabufFormatsMethod "contains" o = DmabufFormatsContainsMethodInfo
    ResolveDmabufFormatsMethod "equal" o = DmabufFormatsEqualMethodInfo
    ResolveDmabufFormatsMethod "ref" o = DmabufFormatsRefMethodInfo
    ResolveDmabufFormatsMethod "unref" o = DmabufFormatsUnrefMethodInfo
    ResolveDmabufFormatsMethod "getFormat" o = DmabufFormatsGetFormatMethodInfo
    ResolveDmabufFormatsMethod "getNFormats" o = DmabufFormatsGetNFormatsMethodInfo
    ResolveDmabufFormatsMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDmabufFormatsMethod t DmabufFormats, O.OverloadedMethod info DmabufFormats p) => OL.IsLabel t (DmabufFormats -> 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 ~ ResolveDmabufFormatsMethod t DmabufFormats, O.OverloadedMethod info DmabufFormats p, R.HasField t DmabufFormats p) => R.HasField t DmabufFormats p where
    getField = O.overloadedMethod @info

#endif

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

#endif