{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The @GdkContentFormats@ structure is used to advertise and negotiate the
-- format of content.
-- 
-- You will encounter @GdkContentFormats@ when interacting with objects
-- controlling operations that pass data between different widgets, window
-- or application, like t'GI.Gdk.Objects.Drag.Drag', t'GI.Gdk.Objects.Drop.Drop',
-- t'GI.Gdk.Objects.Clipboard.Clipboard' or t'GI.Gdk.Objects.ContentProvider.ContentProvider'.
-- 
-- GDK supports content in 2 forms: @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. To transform between the two forms,
-- t'GI.Gdk.Objects.ContentSerializer.ContentSerializer' and t'GI.Gdk.Objects.ContentDeserializer.ContentDeserializer' are used.
-- 
-- A @GdkContentFormats@ 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-separated list of formats from most important
-- to least important.
-- 
-- @GdkContentFormats@ is an immutable struct. After creation, you cannot change
-- the types it represents. Instead, new @GdkContentFormats@ have to be created.
-- The [struct/@gdk@/.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               ,


-- ** parse #method:parse#

    contentFormatsParse                     ,


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

#else
import qualified GI.GLib.Structs.String as GLib.String

#endif

-- | 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
$c== :: ContentFormats -> ContentFormats -> Bool
== :: ContentFormats -> ContentFormats -> Bool
$c/= :: ContentFormats -> ContentFormats -> Bool
/= :: 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 <- Ptr GValue -> IO (Ptr ContentFormats)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr ContentFormats)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed ContentFormats ptr
        else return P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ContentFormats
type instance O.AttributeList ContentFormats = ContentFormatsAttributeList
type ContentFormatsAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
--              , argCallbackUserData = 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 @GdkContentFormats@ 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 [struct/@gdk@/.ContentFormatsBuilder] instead.
contentFormatsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([T.Text])
    -- ^ /@mimeTypes@/: Pointer to an
    --   array of mime types
    -> m ContentFormats
    -- ^ __Returns:__ the new @GdkContentFormats@.
contentFormatsNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Text] -> m ContentFormats
contentFormatsNew Maybe [Text]
mimeTypes = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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 a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Text]
jMimeTypes
    maybeMimeTypes <- case Maybe [Text]
mimeTypes of
        Maybe [Text]
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
FP.nullPtr
        Just [Text]
jMimeTypes -> do
            jMimeTypes' <- [Text] -> IO (Ptr (Ptr CChar))
packUTF8CArray [Text]
jMimeTypes
            return jMimeTypes'
    result <- gdk_content_formats_new maybeMimeTypes nMimeTypes
    checkUnexpectedReturnNULL "contentFormatsNew" result
    result' <- (wrapBoxed ContentFormats) result
    (mapCArrayWithLength nMimeTypes) freeMem maybeMimeTypes
    freeMem maybeMimeTypes
    return 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
--           , argCallbackUserData = 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 @GdkContentFormats@ for a given @GType@.
contentFormatsNewForGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@type@/: a @GType@
    -> m ContentFormats
    -- ^ __Returns:__ a new @GdkContentFormats@
contentFormatsNewForGtype :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> m ContentFormats
contentFormatsNewForGtype GType
type_ = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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_
    result <- CGType -> IO (Ptr ContentFormats)
gdk_content_formats_new_for_gtype CGType
type_'
    checkUnexpectedReturnNULL "contentFormatsNewForGtype" result
    result' <- (wrapBoxed ContentFormats) result
    return 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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @GType@ is part of the given /@formats@/.
contentFormatsContainGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a @GdkContentFormats@
    -> GType
    -- ^ /@type@/: the @GType@ to search for
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the @GType@ was found
contentFormatsContainGtype :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> GType -> m Bool
contentFormatsContainGtype ContentFormats
formats GType
type_ = 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' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    let type_' = GType -> CGType
gtypeToCGType GType
type_
    result <- gdk_content_formats_contain_gtype formats' type_'
    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 ContentFormatsContainGtypeMethodInfo
instance (signature ~ (GType -> m Bool), MonadIO m) => O.OverloadedMethod ContentFormatsContainGtypeMethodInfo ContentFormats signature where
    overloadedMethod = contentFormatsContainGtype

instance O.OverloadedMethodInfo ContentFormatsContainGtypeMethodInfo ContentFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsContainGtype",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @GdkContentFormats@
    -> 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 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' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    mimeType' <- textToCString mimeType
    result <- gdk_content_formats_contain_mime_type formats' mimeType'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr formats
    freeMem mimeType'
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsContainMimeType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_gtypes"
--           , argType = TBasicType TSize
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "optional pointer to take the\n  number of `GType`s contained in the return value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-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 FCT.CSize ->                        -- n_gtypes : TBasicType TSize
    IO (Ptr CGType)

-- | Gets the @GType@s included in /@formats@/.
-- 
-- Note that /@formats@/ may not contain any @GType@s, in particular when
-- they are empty. In that case 'P.Nothing' will be returned.
contentFormatsGetGtypes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a @GdkContentFormats@
    -> m ((Maybe [GType], FCT.CSize))
    -- ^ __Returns:__ 
    --   @/G_TYPE_INVALID/@-terminated array of types included in /@formats@/
contentFormatsGetGtypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m (Maybe [GType], CSize)
contentFormatsGetGtypes ContentFormats
formats = IO (Maybe [GType], CSize) -> m (Maybe [GType], CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [GType], CSize) -> m (Maybe [GType], CSize))
-> IO (Maybe [GType], CSize) -> m (Maybe [GType], CSize)
forall a b. (a -> b) -> a -> b
$ do
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    nGtypes <- allocMem :: IO (Ptr FCT.CSize)
    result <- gdk_content_formats_get_gtypes formats' nGtypes
    maybeResult <- convertIfNonNull result $ \Ptr CGType
result' -> do
        result'' <- ((CGType -> GType) -> Ptr CGType -> IO [GType]
forall a b.
(Eq a, Num a, Storable a) =>
(a -> b) -> Ptr a -> IO [b]
unpackMapZeroTerminatedStorableArray CGType -> GType
GType) Ptr CGType
result'
        return result''
    nGtypes' <- peek nGtypes
    touchManagedPtr formats
    freeMem nGtypes
    return (maybeResult, nGtypes')

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

instance O.OverloadedMethodInfo ContentFormatsGetGtypesMethodInfo ContentFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsGetGtypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_mime_types"
--           , argType = TBasicType TSize
--           , 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
--           , argCallbackUserData = 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 FCT.CSize ->                        -- n_mime_types : TBasicType TSize
    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 @GdkContentFormats@
    -> m ((Maybe [T.Text], FCT.CSize))
    -- ^ __Returns:__ 
    --   'P.Nothing'-terminated array of interned strings of mime types included
    --   in /@formats@/
contentFormatsGetMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m (Maybe [Text], CSize)
contentFormatsGetMimeTypes ContentFormats
formats = IO (Maybe [Text], CSize) -> m (Maybe [Text], CSize)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Text], CSize) -> m (Maybe [Text], CSize))
-> IO (Maybe [Text], CSize) -> m (Maybe [Text], CSize)
forall a b. (a -> b) -> a -> b
$ do
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    nMimeTypes <- allocMem :: IO (Ptr FCT.CSize)
    result <- gdk_content_formats_get_mime_types formats' nMimeTypes
    maybeResult <- convertIfNonNull result $ \Ptr (Ptr CChar)
result' -> do
        result'' <- HasCallStack => Ptr (Ptr CChar) -> IO [Text]
Ptr (Ptr CChar) -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr (Ptr CChar)
result'
        return result''
    nMimeTypes' <- peek nMimeTypes
    touchManagedPtr formats
    freeMem nMimeTypes
    return (maybeResult, nMimeTypes')

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

instance O.OverloadedMethodInfo ContentFormatsGetMimeTypesMethodInfo ContentFormats where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsGetMimeTypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @GdkContentFormats@ to intersect
    -> ContentFormats
    -- ^ /@second@/: the @GdkContentFormats@ 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 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
    first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
first
    second' <- unsafeManagedPtrGetPtr second
    result <- gdk_content_formats_match first' second'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr first
    touchManagedPtr second
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsMatch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @GType@ from /@first@/ that is also contained
-- in /@second@/.
-- 
-- If no matching @GType@ is found, @/G_TYPE_INVALID/@ is returned.
contentFormatsMatchGtype ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@first@/: the primary @GdkContentFormats@ to intersect
    -> ContentFormats
    -- ^ /@second@/: the @GdkContentFormats@ to intersect with
    -> m GType
    -- ^ __Returns:__ The first common @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 a. IO a -> m a
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
    first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
first
    second' <- unsafeManagedPtrGetPtr second
    result <- gdk_content_formats_match_gtype first' second'
    let result' = CGType -> GType
GType CGType
result
    touchManagedPtr first
    touchManagedPtr second
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsMatchGtype",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @GdkContentFormats@ to intersect
    -> ContentFormats
    -- ^ /@second@/: the @GdkContentFormats@ 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 a. IO a -> m a
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
    first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
first
    second' <- unsafeManagedPtrGetPtr second
    result <- gdk_content_formats_match_mime_type first' second'
    maybeResult <- convertIfNonNull result $ \Ptr CChar
result' -> do
        result'' <- HasCallStack => Ptr CChar -> IO Text
Ptr CChar -> IO Text
cstringToText Ptr CChar
result'
        return result''
    touchManagedPtr first
    touchManagedPtr second
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsMatchMimeType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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.
-- 
-- The result of this function can later be parsed with
-- [func/@gdk@/.ContentFormats.parse].
contentFormatsPrint ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a @GdkContentFormats@
    -> GLib.String.String
    -- ^ /@string@/: a @GString@ to print into
    -> m ()
contentFormatsPrint :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> String -> m ()
contentFormatsPrint ContentFormats
formats String
string = 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' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    string' <- unsafeManagedPtrGetPtr string
    gdk_content_formats_print formats' string'
    touchManagedPtr formats
    touchManagedPtr string
    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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsPrint",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkContentFormats@ by one.
contentFormatsRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a @GdkContentFormats@
    -> m ContentFormats
    -- ^ __Returns:__ the passed in @GdkContentFormats@.
contentFormatsRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsRef ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    result <- gdk_content_formats_ref formats'
    checkUnexpectedReturnNULL "contentFormatsRef" result
    result' <- (wrapBoxed ContentFormats) result
    touchManagedPtr formats
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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.
-- 
-- The resulting string can be parsed with [func/@gdk@/.ContentFormats.parse].
-- 
-- This is a small wrapper around 'GI.Gdk.Structs.ContentFormats.contentFormatsPrint'
-- to help when debugging.
contentFormatsToString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a @GdkContentFormats@
    -> m T.Text
    -- ^ __Returns:__ a new string
contentFormatsToString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m Text
contentFormatsToString ContentFormats
formats = IO Text -> m Text
forall a. IO a -> m a
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
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    result <- gdk_content_formats_to_string formats'
    checkUnexpectedReturnNULL "contentFormatsToString" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr formats
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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 @GdkContentFormats@ to merge into
    -> ContentFormats
    -- ^ /@second@/: the @GdkContentFormats@ to merge from
    -> m ContentFormats
    -- ^ __Returns:__ a new @GdkContentFormats@
contentFormatsUnion :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> ContentFormats -> m ContentFormats
contentFormatsUnion ContentFormats
first ContentFormats
second = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    first' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
first
    second' <- unsafeManagedPtrGetPtr second
    result <- gdk_content_formats_union first' second'
    checkUnexpectedReturnNULL "contentFormatsUnion" result
    result' <- (wrapBoxed ContentFormats) result
    touchManagedPtr first
    touchManagedPtr second
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkContentFormats@
    -> m ContentFormats
    -- ^ __Returns:__ a new @GdkContentFormats@
contentFormatsUnionDeserializeGtypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionDeserializeGtypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    result <- gdk_content_formats_union_deserialize_gtypes formats'
    checkUnexpectedReturnNULL "contentFormatsUnionDeserializeGtypes" result
    result' <- (wrapBoxed ContentFormats) result
    touchManagedPtr formats
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionDeserializeGtypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkContentFormats@
    -> m ContentFormats
    -- ^ __Returns:__ a new @GdkContentFormats@
contentFormatsUnionDeserializeMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionDeserializeMimeTypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    result <- gdk_content_formats_union_deserialize_mime_types formats'
    checkUnexpectedReturnNULL "contentFormatsUnionDeserializeMimeTypes" result
    result' <- (wrapBoxed ContentFormats) result
    touchManagedPtr formats
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionDeserializeMimeTypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkContentFormats@
    -> m ContentFormats
    -- ^ __Returns:__ a new @GdkContentFormats@
contentFormatsUnionSerializeGtypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionSerializeGtypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    result <- gdk_content_formats_union_serialize_gtypes formats'
    checkUnexpectedReturnNULL "contentFormatsUnionSerializeGtypes" result
    result' <- (wrapBoxed ContentFormats) result
    touchManagedPtr formats
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionSerializeGtypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkContentFormats@
    -> m ContentFormats
    -- ^ __Returns:__ a new @GdkContentFormats@
contentFormatsUnionSerializeMimeTypes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ContentFormats
contentFormatsUnionSerializeMimeTypes ContentFormats
formats = IO ContentFormats -> m ContentFormats
forall a. IO a -> m a
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
    formats' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, GBoxed a) => a -> IO (Ptr a)
B.ManagedPtr.disownBoxed ContentFormats
formats
    result <- gdk_content_formats_union_serialize_mime_types formats'
    checkUnexpectedReturnNULL "contentFormatsUnionSerializeMimeTypes" result
    result' <- (wrapBoxed ContentFormats) result
    touchManagedPtr formats
    return 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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnionSerializeMimeTypes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/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
--           , argCallbackUserData = 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 @GdkContentFormats@ by one.
-- 
-- If the resulting reference count is zero, frees the formats.
contentFormatsUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    ContentFormats
    -- ^ /@formats@/: a @GdkContentFormats@
    -> m ()
contentFormatsUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
ContentFormats -> m ()
contentFormatsUnref ContentFormats
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' <- ContentFormats -> IO (Ptr ContentFormats)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr ContentFormats
formats
    gdk_content_formats_unref formats'
    touchManagedPtr formats
    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 = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gdk.Structs.ContentFormats.contentFormatsUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gdk-4.0.9/docs/GI-Gdk-Structs-ContentFormats.html#v:contentFormatsUnref"
        })


#endif

-- method ContentFormats::parse
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the string to parse"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gdk" , name = "ContentFormats" })
-- throws : False
-- Skip return : False

foreign import ccall "gdk_content_formats_parse" gdk_content_formats_parse :: 
    CString ->                              -- string : TBasicType TUTF8
    IO (Ptr ContentFormats)

-- | Parses the given /@string@/ into @GdkContentFormats@ and
-- returns the formats.
-- 
-- Strings printed via 'GI.Gdk.Structs.ContentFormats.contentFormatsToString'
-- can be read in again successfully using this function.
-- 
-- If /@string@/ does not describe valid content formats, 'P.Nothing'
-- is returned.
-- 
-- /Since: 4.4/
contentFormatsParse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@string@/: the string to parse
    -> m (Maybe ContentFormats)
    -- ^ __Returns:__ the content formats if /@string@/ is valid
contentFormatsParse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe ContentFormats)
contentFormatsParse Text
string = IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContentFormats) -> m (Maybe ContentFormats))
-> IO (Maybe ContentFormats) -> m (Maybe ContentFormats)
forall a b. (a -> b) -> a -> b
$ do
    string' <- Text -> IO (Ptr CChar)
textToCString Text
string
    result <- gdk_content_formats_parse string'
    maybeResult <- convertIfNonNull result $ \Ptr ContentFormats
result' -> do
        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'
        return result''
    freeMem string'
    return maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveContentFormatsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type 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