{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This section describes the t'GI.Gdk.Structs.ContentFormats.ContentFormats' structure that is used to
-- advertise and negotiate the format of content passed between different
-- widgets, windows or applications using for example the clipboard or
-- drag\'n\'drop.
-- 
-- GDK supports content in 2 forms: t'GType' and mime type.
-- Using @/GTypes/@ is meant only for in-process content transfers. Mime types
-- are meant to be used for data passing both in-process and out-of-process.
-- The details of how data is passed is described in the documentation of
-- the actual implementations.
-- 
-- A t'GI.Gdk.Structs.ContentFormats.ContentFormats' describes a set of possible formats content can be
-- exchanged in. It is assumed that this set is ordered. @/GTypes/@ are more
-- important than mime types. Order between different @/GTypes/@ or mime types
-- is the order they were added in, most important first. Functions that
-- care about order, such as 'GI.Gdk.Structs.ContentFormats.contentFormatsUnion' will describe in
-- their documentation how they interpret that order, though in general the
-- order of the first argument is considered the primary order of the result,
-- followed by the order of further arguments.
-- 
-- For debugging purposes, the function 'GI.Gdk.Structs.ContentFormats.contentFormatsToString' exists.
-- It will print a comma-seperated formats of formats from most important to least
-- important.
-- 
-- t'GI.Gdk.Structs.ContentFormats.ContentFormats' is an immutable struct. After creation, you cannot change
-- the types it represents. Instead, new t'GI.Gdk.Structs.ContentFormats.ContentFormats' have to be created.
-- The t'GI.Gdk.Structs.ContentFormatsBuilder.ContentFormatsBuilder' structure is meant to help in this endeavor.

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

module GI.Gdk.Structs.ContentFormats
    ( 

-- * Exported types
    ContentFormats(..)                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [containGtype]("GI.Gdk.Structs.ContentFormats#g:method:containGtype"), [containMimeType]("GI.Gdk.Structs.ContentFormats#g:method:containMimeType"), [match]("GI.Gdk.Structs.ContentFormats#g:method:match"), [matchGtype]("GI.Gdk.Structs.ContentFormats#g:method:matchGtype"), [matchMimeType]("GI.Gdk.Structs.ContentFormats#g:method:matchMimeType"), [print]("GI.Gdk.Structs.ContentFormats#g:method:print"), [ref]("GI.Gdk.Structs.ContentFormats#g:method:ref"), [toString]("GI.Gdk.Structs.ContentFormats#g:method:toString"), [union]("GI.Gdk.Structs.ContentFormats#g:method:union"), [unionDeserializeGtypes]("GI.Gdk.Structs.ContentFormats#g:method:unionDeserializeGtypes"), [unionDeserializeMimeTypes]("GI.Gdk.Structs.ContentFormats#g:method:unionDeserializeMimeTypes"), [unionSerializeGtypes]("GI.Gdk.Structs.ContentFormats#g:method:unionSerializeGtypes"), [unionSerializeMimeTypes]("GI.Gdk.Structs.ContentFormats#g:method:unionSerializeMimeTypes"), [unref]("GI.Gdk.Structs.ContentFormats#g:method:unref").
-- 
-- ==== Getters
-- [getGtypes]("GI.Gdk.Structs.ContentFormats#g:method:getGtypes"), [getMimeTypes]("GI.Gdk.Structs.ContentFormats#g:method:getMimeTypes").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveContentFormatsMethod             ,
#endif

-- ** containGtype #method:containGtype#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsContainGtypeMethodInfo    ,
#endif
    contentFormatsContainGtype              ,


-- ** containMimeType #method:containMimeType#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsContainMimeTypeMethodInfo ,
#endif
    contentFormatsContainMimeType           ,


-- ** getGtypes #method:getGtypes#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsGetGtypesMethodInfo       ,
#endif
    contentFormatsGetGtypes                 ,


-- ** getMimeTypes #method:getMimeTypes#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsGetMimeTypesMethodInfo    ,
#endif
    contentFormatsGetMimeTypes              ,


-- ** match #method:match#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsMatchMethodInfo           ,
#endif
    contentFormatsMatch                     ,


-- ** matchGtype #method:matchGtype#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsMatchGtypeMethodInfo      ,
#endif
    contentFormatsMatchGtype                ,


-- ** matchMimeType #method:matchMimeType#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsMatchMimeTypeMethodInfo   ,
#endif
    contentFormatsMatchMimeType             ,


-- ** new #method:new#

    contentFormatsNew                       ,


-- ** newForGtype #method:newForGtype#

    contentFormatsNewForGtype               ,


-- ** print #method:print#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsPrintMethodInfo           ,
#endif
    contentFormatsPrint                     ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsRefMethodInfo             ,
#endif
    contentFormatsRef                       ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsToStringMethodInfo        ,
#endif
    contentFormatsToString                  ,


-- ** union #method:union#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsUnionMethodInfo           ,
#endif
    contentFormatsUnion                     ,


-- ** unionDeserializeGtypes #method:unionDeserializeGtypes#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsUnionDeserializeGtypesMethodInfo,
#endif
    contentFormatsUnionDeserializeGtypes    ,


-- ** unionDeserializeMimeTypes #method:unionDeserializeMimeTypes#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsUnionDeserializeMimeTypesMethodInfo,
#endif
    contentFormatsUnionDeserializeMimeTypes ,


-- ** unionSerializeGtypes #method:unionSerializeGtypes#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsUnionSerializeGtypesMethodInfo,
#endif
    contentFormatsUnionSerializeGtypes      ,


-- ** unionSerializeMimeTypes #method:unionSerializeMimeTypes#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsUnionSerializeMimeTypesMethodInfo,
#endif
    contentFormatsUnionSerializeMimeTypes   ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ContentFormatsUnrefMethodInfo           ,
#endif
    contentFormatsUnref                     ,




    ) 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 qualified GI.GLib.Structs.String as GLib.String

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

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

foreign import ccall "gdk_content_formats_get_type" c_gdk_content_formats_get_type :: 
    IO GType

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

instance B.Types.TypedObject ContentFormats where
    glibType :: IO GType
glibType = IO GType
c_gdk_content_formats_get_type

instance B.Types.GBoxed ContentFormats

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


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

-- method ContentFormats::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "mime_types"
--           , argType = TCArray False (-1) 1 (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Pointer to an\n  array of mime types"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_mime_types"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "number of entries in @mime_types."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_mime_types"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "number of entries in @mime_types."
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentFormats" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_new" gdk_content_formats_new :: 
    Ptr CString ->                          -- mime_types : TCArray False (-1) 1 (TBasicType TUTF8)
    Word32 ->                               -- n_mime_types : TBasicType TUInt
    IO (Ptr ContentFormats)

-- | Creates a new t'GI.Gdk.Structs.ContentFormats.ContentFormats' from an array of mime types.
-- 
-- The mime types must be valid and different from each other or the
-- behavior of the return value is undefined. If you cannot guarantee
-- this, use t'GI.Gdk.Structs.ContentFormatsBuilder.ContentFormatsBuilder' instead.
contentFormatsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([T.Text])
    -- ^ /@mimeTypes@/: Pointer to an
    --   array of mime types
    -> m ContentFormats
    -- ^ __Returns:__ the new t'GI.Gdk.Structs.ContentFormats.ContentFormats'.
contentFormatsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text] -> m ContentFormats
contentFormatsNew Maybe [Text]
mimeTypes = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    let nMimeTypes :: Word32
nMimeTypes = case Maybe [Text]
mimeTypes of
            Maybe [Text]
Nothing -> Word32
0
            Just [Text]
jMimeTypes -> Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
jMimeTypes
    Ptr (Ptr CChar)
maybeMimeTypes <- case Maybe [Text]
mimeTypes of
        Maybe [Text]
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
nullPtr
        Just [Text]
jMimeTypes -> do
            Ptr (Ptr CChar)
jMimeTypes' <- [Text] -> IO (Ptr (Ptr CChar))
packUTF8CArray [Text]
jMimeTypes
            Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
jMimeTypes'
    Ptr ContentFormats
result <- Ptr (Ptr CChar) -> Word32 -> IO (Ptr ContentFormats)
gdk_content_formats_new Ptr (Ptr CChar)
maybeMimeTypes Word32
nMimeTypes
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsNew" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    (Word32 -> (Ptr CChar -> IO ()) -> Ptr (Ptr CChar) -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Word32
nMimeTypes) Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
maybeMimeTypes
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CChar)
maybeMimeTypes
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContentFormats::new_for_gtype
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a $GType" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentFormats" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_new_for_gtype" gdk_content_formats_new_for_gtype :: 
    CGType ->                               -- type : TBasicType TGType
    IO (Ptr ContentFormats)

-- | Creates a new t'GI.Gdk.Structs.ContentFormats.ContentFormats' for a given t'GType'.
contentFormatsNewForGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: a $GType
    -> m ContentFormats
    -- ^ __Returns:__ a new t'GI.Gdk.Structs.ContentFormats.ContentFormats'
contentFormatsNewForGtype :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> m ContentFormats
contentFormatsNewForGtype GType
type_ = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    Ptr ContentFormats
result <- CGType -> IO (Ptr ContentFormats)
gdk_content_formats_new_for_gtype CGType
type_'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsNewForGtype" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContentFormats::contain_gtype
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentFormats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GType to search for"
--                 , 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_content_formats_contain_gtype" gdk_content_formats_contain_gtype :: 
    Ptr ContentFormats ->                   -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    CGType ->                               -- type : TBasicType TGType
    IO CInt

-- | Checks if a given t'GType' is part of the given /@formats@/.
contentFormatsContainGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> GType
    -- ^ /@type@/: the t'GType' to search for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the t'GType' was found
contentFormatsContainGtype :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> GType -> m Bool
contentFormatsContainGtype ContentFormats
formats GType
type_ = 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 ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    CInt
result <- Ptr ContentFormats -> CGType -> IO CInt
gdk_content_formats_contain_gtype Ptr ContentFormats
formats' CGType
type_'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsContainGtypeMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m) => O.OverloadedMethod ContentFormatsContainGtypeMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsContainGtype

instance O.OverloadedMethodInfo ContentFormatsContainGtypeMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsContainGtype",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsContainGtype"
        }


#endif

-- method ContentFormats::contain_mime_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentFormats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the mime type to search for"
--                 , 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_content_formats_contain_mime_type" gdk_content_formats_contain_mime_type :: 
    Ptr ContentFormats ->                   -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    CString ->                              -- mime_type : TBasicType TUTF8
    IO CInt

-- | Checks if a given mime type is part of the given /@formats@/.
contentFormatsContainMimeType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> T.Text
    -- ^ /@mimeType@/: the mime type to search for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the mime_type was found
contentFormatsContainMimeType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> Text -> m Bool
contentFormatsContainMimeType ContentFormats
formats Text
mimeType = 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 ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr CChar
mimeType' <- Text -> IO (Ptr CChar)
textToCString Text
mimeType
    CInt
result <- Ptr ContentFormats -> Ptr CChar -> IO CInt
gdk_content_formats_contain_mime_type Ptr ContentFormats
formats' Ptr CChar
mimeType'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
mimeType'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsContainMimeTypeMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod ContentFormatsContainMimeTypeMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsContainMimeType

instance O.OverloadedMethodInfo ContentFormatsContainMimeTypeMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsContainMimeType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsContainMimeType"
        }


#endif

-- method ContentFormats::get_gtypes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentFormats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_gtypes"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "optional pointer to take the\n    number of #GTypes contained in the return value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_gtypes"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "optional pointer to take the\n    number of #GTypes contained in the return value"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TGType))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_get_gtypes" gdk_content_formats_get_gtypes :: 
    Ptr ContentFormats ->                   -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr Word64 ->                           -- n_gtypes : TBasicType TUInt64
    IO (Ptr CGType)

-- | Gets the @/GTypes/@ included in /@formats@/. Note that /@formats@/ may not
-- contain any @/GTypes/@, in particular when they are empty. In that
-- case 'P.Nothing' will be returned.
contentFormatsGetGtypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m (Maybe [GType])
    -- ^ __Returns:__ 
    --      @/G_TYPE_INVALID/@-terminated array of types included in /@formats@/ or
    --      'P.Nothing' if none.
contentFormatsGetGtypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m (Maybe [GType])
contentFormatsGetGtypes ContentFormats
formats = IO (Maybe [GType]) -> m (Maybe [GType])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [GType]) -> m (Maybe [GType]))
-> IO (Maybe [GType]) -> m (Maybe [GType])
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr CGType
nGtypes <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CGType
result <- Ptr ContentFormats -> Ptr CGType -> IO (Ptr CGType)
gdk_content_formats_get_gtypes Ptr ContentFormats
formats' Ptr CGType
nGtypes
    CGType
nGtypes' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
nGtypes
    Maybe [GType]
maybeResult <- Ptr CGType -> (Ptr CGType -> IO [GType]) -> IO (Maybe [GType])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CGType
result ((Ptr CGType -> IO [GType]) -> IO (Maybe [GType]))
-> (Ptr CGType -> IO [GType]) -> IO (Maybe [GType])
forall a b. (a -> b) -> a -> b
$ \Ptr CGType
result' -> do
        [GType]
result'' <- ((CGType -> GType) -> CGType -> Ptr CGType -> IO [GType]
forall a b c.
(Integral a, Storable b) =>
(b -> c) -> a -> Ptr b -> IO [c]
unpackMapStorableArrayWithLength CGType -> GType
GType CGType
nGtypes') Ptr CGType
result'
        [GType] -> IO [GType]
forall (m :: * -> *) a. Monad m => a -> m a
return [GType]
result''
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
nGtypes
    Maybe [GType] -> IO (Maybe [GType])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [GType]
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContentFormatsGetGtypesMethodInfo
instance (signature ~ (m (Maybe [GType])), MonadIO m) => O.OverloadedMethod ContentFormatsGetGtypesMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsGetGtypes

instance O.OverloadedMethodInfo ContentFormatsGetGtypesMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsGetGtypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsGetGtypes"
        }


#endif

-- method ContentFormats::get_mime_types
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentFormats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_mime_types"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "optional pointer to take the\n    number of mime types contained in the return value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_get_mime_types" gdk_content_formats_get_mime_types :: 
    Ptr ContentFormats ->                   -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr Word64 ->                           -- n_mime_types : TBasicType TUInt64
    IO (Ptr CString)

-- | Gets the mime types included in /@formats@/. Note that /@formats@/ may not
-- contain any mime types, in particular when they are empty. In that
-- case 'P.Nothing' will be returned.
contentFormatsGetMimeTypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ((Maybe [T.Text], Word64))
    -- ^ __Returns:__ 'P.Nothing'-terminated array of
    --     interned strings of mime types included in /@formats@/ or 'P.Nothing'
    --     if none.
contentFormatsGetMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m (Maybe [Text], CGType)
contentFormatsGetMimeTypes ContentFormats
formats = IO (Maybe [Text], CGType) -> m (Maybe [Text], CGType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text], CGType) -> m (Maybe [Text], CGType))
-> IO (Maybe [Text], CGType) -> m (Maybe [Text], CGType)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr CGType
nMimeTypes <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr (Ptr CChar)
result <- Ptr ContentFormats -> Ptr CGType -> IO (Ptr (Ptr CChar))
gdk_content_formats_get_mime_types Ptr ContentFormats
formats' Ptr CGType
nMimeTypes
    Maybe [Text]
maybeResult <- Ptr (Ptr CChar)
-> (Ptr (Ptr CChar) -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr (Ptr CChar)
result ((Ptr (Ptr CChar) -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr (Ptr CChar) -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
result' -> do
        [Text]
result'' <- HasCallStack => Ptr (Ptr CChar) -> IO [Text]
Ptr (Ptr CChar) -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr (Ptr CChar)
result'
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''
    CGType
nMimeTypes' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
nMimeTypes
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
nMimeTypes
    (Maybe [Text], CGType) -> IO (Maybe [Text], CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Text]
maybeResult, CGType
nMimeTypes')

#if defined(ENABLE_OVERLOADING)
data ContentFormatsGetMimeTypesMethodInfo
instance (signature ~ (m ((Maybe [T.Text], Word64))), MonadIO m) => O.OverloadedMethod ContentFormatsGetMimeTypesMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsGetMimeTypes

instance O.OverloadedMethodInfo ContentFormatsGetMimeTypesMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsGetMimeTypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsGetMimeTypes"
        }


#endif

-- method ContentFormats::match
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "first"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the primary #GdkContentFormats to intersect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "second"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkContentFormats to intersect with"
--                 , 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_content_formats_match" gdk_content_formats_match :: 
    Ptr ContentFormats ->                   -- first : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr ContentFormats ->                   -- second : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    IO CInt

-- | Checks if /@first@/ and /@second@/ have any matching formats.
contentFormatsMatch ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@first@/: the primary t'GI.Gdk.Structs.ContentFormats.ContentFormats' to intersect
    -> ContentFormats
    -- ^ /@second@/: the t'GI.Gdk.Structs.ContentFormats.ContentFormats' to intersect with
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a matching format was found.
contentFormatsMatch :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> ContentFormats -> m Bool
contentFormatsMatch ContentFormats
first ContentFormats
second = 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 ContentFormats
first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
first
    Ptr ContentFormats
second' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
second
    CInt
result <- Ptr ContentFormats -> Ptr ContentFormats -> IO CInt
gdk_content_formats_match Ptr ContentFormats
first' Ptr ContentFormats
second'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
first
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
second
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsMatchMethodInfo
instance (signature ~ (ContentFormats -> m Bool), MonadIO m) => O.OverloadedMethod ContentFormatsMatchMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsMatch

instance O.OverloadedMethodInfo ContentFormatsMatchMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsMatch",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsMatch"
        }


#endif

-- method ContentFormats::match_gtype
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "first"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the primary #GdkContentFormats to intersect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "second"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkContentFormats to intersect with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_match_gtype" gdk_content_formats_match_gtype :: 
    Ptr ContentFormats ->                   -- first : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr ContentFormats ->                   -- second : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    IO CGType

-- | Finds the first t'GType' from /@first@/ that is also contained
-- in /@second@/. If no matching t'GType' is found, @/G_TYPE_INVALID/@
-- is returned.
contentFormatsMatchGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@first@/: the primary t'GI.Gdk.Structs.ContentFormats.ContentFormats' to intersect
    -> ContentFormats
    -- ^ /@second@/: the t'GI.Gdk.Structs.ContentFormats.ContentFormats' to intersect with
    -> m GType
    -- ^ __Returns:__ The first common t'GType' or @/G_TYPE_INVALID/@ if none.
contentFormatsMatchGtype :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> ContentFormats -> m GType
contentFormatsMatchGtype ContentFormats
first ContentFormats
second = IO GType -> m GType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
first
    Ptr ContentFormats
second' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
second
    CGType
result <- Ptr ContentFormats -> Ptr ContentFormats -> IO CGType
gdk_content_formats_match_gtype Ptr ContentFormats
first' Ptr ContentFormats
second'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
first
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
second
    GType -> IO GType
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsMatchGtypeMethodInfo
instance (signature ~ (ContentFormats -> m GType), MonadIO m) => O.OverloadedMethod ContentFormatsMatchGtypeMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsMatchGtype

instance O.OverloadedMethodInfo ContentFormatsMatchGtypeMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsMatchGtype",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsMatchGtype"
        }


#endif

-- method ContentFormats::match_mime_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "first"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the primary #GdkContentFormats to intersect"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "second"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkContentFormats to intersect with"
--                 , 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_content_formats_match_mime_type" gdk_content_formats_match_mime_type :: 
    Ptr ContentFormats ->                   -- first : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr ContentFormats ->                   -- second : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    IO CString

-- | Finds the first mime type from /@first@/ that is also contained
-- in /@second@/. If no matching mime type is found, 'P.Nothing' is
-- returned.
contentFormatsMatchMimeType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@first@/: the primary t'GI.Gdk.Structs.ContentFormats.ContentFormats' to intersect
    -> ContentFormats
    -- ^ /@second@/: the t'GI.Gdk.Structs.ContentFormats.ContentFormats' to intersect with
    -> m (Maybe T.Text)
    -- ^ __Returns:__ The first common mime type or 'P.Nothing' if none.
contentFormatsMatchMimeType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> ContentFormats -> m (Maybe Text)
contentFormatsMatchMimeType ContentFormats
first ContentFormats
second = 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
$ do
    Ptr ContentFormats
first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
first
    Ptr ContentFormats
second' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
second
    Ptr CChar
result <- Ptr ContentFormats -> Ptr ContentFormats -> IO (Ptr CChar)
gdk_content_formats_match_mime_type Ptr ContentFormats
first' Ptr ContentFormats
second'
    Maybe Text
maybeResult <- Ptr CChar -> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CChar
result ((Ptr CChar -> IO Text) -> IO (Maybe Text))
-> (Ptr CChar -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
result' -> do
        Text
result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
first
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
second
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContentFormatsMatchMimeTypeMethodInfo
instance (signature ~ (ContentFormats -> m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod ContentFormatsMatchMimeTypeMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsMatchMimeType

instance O.OverloadedMethodInfo ContentFormatsMatchMimeTypeMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsMatchMimeType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsMatchMimeType"
        }


#endif

-- method ContentFormats::print
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentFormats"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "string"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GString to print into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_print" gdk_content_formats_print :: 
    Ptr ContentFormats ->                   -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr GLib.String.String ->               -- string : TInterface (Name {namespace = "GLib", name = "String"})
    IO ()

-- | Prints the given /@formats@/ into a string for human consumption.
-- This is meant for debugging and logging.
-- 
-- The form of the representation may change at any time and is
-- not guaranteed to stay identical.
contentFormatsPrint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> GLib.String.String
    -- ^ /@string@/: a t'GI.GLib.Structs.String.String' to print into
    -> m ()
contentFormatsPrint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> String -> m ()
contentFormatsPrint ContentFormats
formats String
string = 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 ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr String
string' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
string
    Ptr ContentFormats -> Ptr String -> IO ()
gdk_content_formats_print Ptr ContentFormats
formats' Ptr String
string'
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
string
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContentFormatsPrintMethodInfo
instance (signature ~ (GLib.String.String -> m ()), MonadIO m) => O.OverloadedMethod ContentFormatsPrintMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsPrint

instance O.OverloadedMethodInfo ContentFormatsPrintMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsPrint",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsPrint"
        }


#endif

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

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

-- | Increases the reference count of a t'GI.Gdk.Structs.ContentFormats.ContentFormats' by one.
contentFormatsRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ContentFormats
    -- ^ __Returns:__ the passed in t'GI.Gdk.Structs.ContentFormats.ContentFormats'.
contentFormatsRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsRef ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr ContentFormats
result <- Ptr ContentFormats -> IO (Ptr ContentFormats)
gdk_content_formats_ref Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsRef" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsRefMethodInfo
instance (signature ~ (m ContentFormats), MonadIO m) => O.OverloadedMethod ContentFormatsRefMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsRef

instance O.OverloadedMethodInfo ContentFormatsRefMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsRef",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsRef"
        }


#endif

-- method ContentFormats::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "formats"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GdkContentFormats"
--                 , 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_content_formats_to_string" gdk_content_formats_to_string :: 
    Ptr ContentFormats ->                   -- formats : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    IO CString

-- | Prints the given /@formats@/ into a human-readable string.
-- This is a small wrapper around 'GI.Gdk.Structs.ContentFormats.contentFormatsPrint' to help
-- when debugging.
contentFormatsToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m T.Text
    -- ^ __Returns:__ a new string
contentFormatsToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m Text
contentFormatsToString ContentFormats
formats = 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 ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr CChar
result <- Ptr ContentFormats -> IO (Ptr CChar)
gdk_content_formats_to_string Ptr ContentFormats
formats'
    Text -> Ptr CChar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsToString" Ptr CChar
result
    Text
result' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod ContentFormatsToStringMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsToString

instance O.OverloadedMethodInfo ContentFormatsToStringMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsToString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsToString"
        }


#endif

-- method ContentFormats::union
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "first"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkContentFormats to merge into"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "second"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "ContentFormats" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GdkContentFormats to merge from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentFormats" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_union" gdk_content_formats_union :: 
    Ptr ContentFormats ->                   -- first : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    Ptr ContentFormats ->                   -- second : TInterface (Name {namespace = "Gdk", name = "ContentFormats"})
    IO (Ptr ContentFormats)

-- | Append all missing types from /@second@/ to /@first@/, in the order
-- they had in /@second@/.
contentFormatsUnion ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@first@/: the t'GI.Gdk.Structs.ContentFormats.ContentFormats' to merge into
    -> ContentFormats
    -- ^ /@second@/: the t'GI.Gdk.Structs.ContentFormats.ContentFormats' to merge from
    -> m ContentFormats
    -- ^ __Returns:__ a new t'GI.Gdk.Structs.ContentFormats.ContentFormats'
contentFormatsUnion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> ContentFormats -> m ContentFormats
contentFormatsUnion ContentFormats
first ContentFormats
second = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
first
    Ptr ContentFormats
second' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
second
    Ptr ContentFormats
result <- Ptr ContentFormats -> Ptr ContentFormats -> IO (Ptr ContentFormats)
gdk_content_formats_union Ptr ContentFormats
first' Ptr ContentFormats
second'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsUnion" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
first
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
second
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsUnionMethodInfo
instance (signature ~ (ContentFormats -> m ContentFormats), MonadIO m) => O.OverloadedMethod ContentFormatsUnionMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsUnion

instance O.OverloadedMethodInfo ContentFormatsUnionMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnion",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnion"
        }


#endif

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

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

-- | Add GTypes for mime types in /@formats@/ for which deserializers are
-- registered.
contentFormatsUnionDeserializeGtypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ContentFormats
    -- ^ __Returns:__ a new t'GI.Gdk.Structs.ContentFormats.ContentFormats'
contentFormatsUnionDeserializeGtypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionDeserializeGtypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    Ptr ContentFormats
result <- Ptr ContentFormats -> IO (Ptr ContentFormats)
gdk_content_formats_union_deserialize_gtypes Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsUnionDeserializeGtypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsUnionDeserializeGtypesMethodInfo
instance (signature ~ (m ContentFormats), MonadIO m) => O.OverloadedMethod ContentFormatsUnionDeserializeGtypesMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsUnionDeserializeGtypes

instance O.OverloadedMethodInfo ContentFormatsUnionDeserializeGtypesMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionDeserializeGtypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnionDeserializeGtypes"
        }


#endif

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

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

-- | Add mime types for GTypes in /@formats@/ for which deserializers are
-- registered.
contentFormatsUnionDeserializeMimeTypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ContentFormats
    -- ^ __Returns:__ a new t'GI.Gdk.Structs.ContentFormats.ContentFormats'
contentFormatsUnionDeserializeMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionDeserializeMimeTypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    Ptr ContentFormats
result <- Ptr ContentFormats -> IO (Ptr ContentFormats)
gdk_content_formats_union_deserialize_mime_types Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsUnionDeserializeMimeTypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsUnionDeserializeMimeTypesMethodInfo
instance (signature ~ (m ContentFormats), MonadIO m) => O.OverloadedMethod ContentFormatsUnionDeserializeMimeTypesMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsUnionDeserializeMimeTypes

instance O.OverloadedMethodInfo ContentFormatsUnionDeserializeMimeTypesMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionDeserializeMimeTypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnionDeserializeMimeTypes"
        }


#endif

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

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

-- | Add GTypes for the mime types in /@formats@/ for which serializers are
-- registered.
contentFormatsUnionSerializeGtypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ContentFormats
    -- ^ __Returns:__ a new t'GI.Gdk.Structs.ContentFormats.ContentFormats'
contentFormatsUnionSerializeGtypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionSerializeGtypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    Ptr ContentFormats
result <- Ptr ContentFormats -> IO (Ptr ContentFormats)
gdk_content_formats_union_serialize_gtypes Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsUnionSerializeGtypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsUnionSerializeGtypesMethodInfo
instance (signature ~ (m ContentFormats), MonadIO m) => O.OverloadedMethod ContentFormatsUnionSerializeGtypesMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsUnionSerializeGtypes

instance O.OverloadedMethodInfo ContentFormatsUnionSerializeGtypesMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionSerializeGtypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnionSerializeGtypes"
        }


#endif

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

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

-- | Add mime types for GTypes in /@formats@/ for which serializers are
-- registered.
contentFormatsUnionSerializeMimeTypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ContentFormats
    -- ^ __Returns:__ a new t'GI.Gdk.Structs.ContentFormats.ContentFormats'
contentFormatsUnionSerializeMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionSerializeMimeTypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContentFormats -> m ContentFormats)
-> IO ContentFormats -> m ContentFormats
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    Ptr ContentFormats
result <- Ptr ContentFormats -> IO (Ptr ContentFormats)
gdk_content_formats_union_serialize_mime_types Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contentFormatsUnionSerializeMimeTypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    ContentFormats -> IO ContentFormats
forall (m :: * -> *) a. Monad m => a -> m a
return ContentFormats
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsUnionSerializeMimeTypesMethodInfo
instance (signature ~ (m ContentFormats), MonadIO m) => O.OverloadedMethod ContentFormatsUnionSerializeMimeTypesMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsUnionSerializeMimeTypes

instance O.OverloadedMethodInfo ContentFormatsUnionSerializeMimeTypesMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionSerializeMimeTypes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnionSerializeMimeTypes"
        }


#endif

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

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

-- | Decreases the reference count of a t'GI.Gdk.Structs.ContentFormats.ContentFormats' by one.
-- If the resulting reference count is zero, frees the formats.
contentFormatsUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a t'GI.Gdk.Structs.ContentFormats.ContentFormats'
    -> m ()
contentFormatsUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ()
contentFormatsUnref ContentFormats
formats = 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 ContentFormats
formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    Ptr ContentFormats -> IO ()
gdk_content_formats_unref Ptr ContentFormats
formats'
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContentFormatsUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod ContentFormatsUnrefMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsUnref

instance O.OverloadedMethodInfo ContentFormatsUnrefMethodInfo ContentFormats where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnref",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gdk-4.0.3/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnref"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveContentFormatsMethod (t :: Symbol) (o :: *) :: * where
    ResolveContentFormatsMethod "containGtype" o = ContentFormatsContainGtypeMethodInfo
    ResolveContentFormatsMethod "containMimeType" o = ContentFormatsContainMimeTypeMethodInfo
    ResolveContentFormatsMethod "match" o = ContentFormatsMatchMethodInfo
    ResolveContentFormatsMethod "matchGtype" o = ContentFormatsMatchGtypeMethodInfo
    ResolveContentFormatsMethod "matchMimeType" o = ContentFormatsMatchMimeTypeMethodInfo
    ResolveContentFormatsMethod "print" o = ContentFormatsPrintMethodInfo
    ResolveContentFormatsMethod "ref" o = ContentFormatsRefMethodInfo
    ResolveContentFormatsMethod "toString" o = ContentFormatsToStringMethodInfo
    ResolveContentFormatsMethod "union" o = ContentFormatsUnionMethodInfo
    ResolveContentFormatsMethod "unionDeserializeGtypes" o = ContentFormatsUnionDeserializeGtypesMethodInfo
    ResolveContentFormatsMethod "unionDeserializeMimeTypes" o = ContentFormatsUnionDeserializeMimeTypesMethodInfo
    ResolveContentFormatsMethod "unionSerializeGtypes" o = ContentFormatsUnionSerializeGtypesMethodInfo
    ResolveContentFormatsMethod "unionSerializeMimeTypes" o = ContentFormatsUnionSerializeMimeTypesMethodInfo
    ResolveContentFormatsMethod "unref" o = ContentFormatsUnrefMethodInfo
    ResolveContentFormatsMethod "getGtypes" o = ContentFormatsGetGtypesMethodInfo
    ResolveContentFormatsMethod "getMimeTypes" o = ContentFormatsGetMimeTypesMethodInfo
    ResolveContentFormatsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif