{-# 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(..)                      ,
    noContentFormats                        ,


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

#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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified 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 GI.GLib.Structs.String as GLib.String

-- | Memory-managed wrapper type.
newtype ContentFormats = ContentFormats (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)
foreign import ccall "gdk_content_formats_get_type" c_gdk_content_formats_get_type :: 
    IO GType

instance BoxedObject ContentFormats where
    boxedType :: ContentFormats -> IO GType
boxedType _ = IO GType
c_gdk_content_formats_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `ContentFormats`.
noContentFormats :: Maybe ContentFormats
noContentFormats :: Maybe ContentFormats
noContentFormats = Maybe ContentFormats
forall a. Maybe a
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 :: Maybe [Text] -> m ContentFormats
contentFormatsNew mimeTypes :: 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
            Nothing -> 0
            Just jMimeTypes :: [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
length [Text]
jMimeTypes
    Ptr CString
maybeMimeTypes <- case Maybe [Text]
mimeTypes of
        Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just jMimeTypes :: [Text]
jMimeTypes -> do
            Ptr CString
jMimeTypes' <- [Text] -> IO (Ptr CString)
packUTF8CArray [Text]
jMimeTypes
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jMimeTypes'
    Ptr ContentFormats
result <- Ptr CString -> Word32 -> IO (Ptr ContentFormats)
gdk_content_formats_new Ptr CString
maybeMimeTypes Word32
nMimeTypes
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsNew" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ContentFormats -> ContentFormats
ContentFormats) Ptr ContentFormats
result
    (Word32 -> (CString -> IO ()) -> Ptr CString -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Word32
nMimeTypes) CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeMimeTypes
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
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 :: GType -> m ContentFormats
contentFormatsNewForGtype type_ :: 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 "contentFormatsNewForGtype" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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 :: ContentFormats -> GType -> m Bool
contentFormatsContainGtype formats :: ContentFormats
formats type_ :: 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
/= 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.MethodInfo ContentFormatsContainGtypeMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> Text -> m Bool
contentFormatsContainMimeType formats :: ContentFormats
formats mimeType :: 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
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    CInt
result <- Ptr ContentFormats -> CString -> IO CInt
gdk_content_formats_contain_mime_type Ptr ContentFormats
formats' CString
mimeType'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo ContentFormatsContainMimeTypeMethodInfo ContentFormats signature where
    overloadedMethod = 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: []
-- returnType: Just (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 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 ((GType, Word64))
    -- ^ __Returns:__ @/G_TYPE_INVALID/@-terminated array of
    --     types included in /@formats@/ or 'P.Nothing' if none.
contentFormatsGetGtypes :: ContentFormats -> m (GType, CGType)
contentFormatsGetGtypes formats :: ContentFormats
formats = IO (GType, CGType) -> m (GType, CGType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GType, CGType) -> m (GType, CGType))
-> IO (GType, CGType) -> m (GType, 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
nGtypes <- IO (Ptr CGType)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    CGType
result <- Ptr ContentFormats -> Ptr CGType -> IO CGType
gdk_content_formats_get_gtypes Ptr ContentFormats
formats' Ptr CGType
nGtypes
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    CGType
nGtypes' <- Ptr CGType -> IO CGType
forall a. Storable a => Ptr a -> IO a
peek Ptr CGType
nGtypes
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
formats
    Ptr CGType -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CGType
nGtypes
    (GType, CGType) -> IO (GType, CGType)
forall (m :: * -> *) a. Monad m => a -> m a
return (GType
result', CGType
nGtypes')

#if defined(ENABLE_OVERLOADING)
data ContentFormatsGetGtypesMethodInfo
instance (signature ~ (m ((GType, Word64))), MonadIO m) => O.MethodInfo ContentFormatsGetGtypesMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> m (Maybe [Text], CGType)
contentFormatsGetMimeTypes formats :: 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 CString
result <- Ptr ContentFormats -> Ptr CGType -> IO (Ptr CString)
gdk_content_formats_get_mime_types Ptr ContentFormats
formats' Ptr CGType
nMimeTypes
    Maybe [Text]
maybeResult <- Ptr CString -> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr CString
result ((Ptr CString -> IO [Text]) -> IO (Maybe [Text]))
-> (Ptr CString -> IO [Text]) -> IO (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr CString
result' -> do
        [Text]
result'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
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.MethodInfo ContentFormatsGetMimeTypesMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> ContentFormats -> m Bool
contentFormatsMatch first :: ContentFormats
first second :: 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
/= 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.MethodInfo ContentFormatsMatchMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> ContentFormats -> m GType
contentFormatsMatchGtype first :: ContentFormats
first second :: 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.MethodInfo ContentFormatsMatchGtypeMethodInfo ContentFormats signature where
    overloadedMethod = 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 T.Text
    -- ^ __Returns:__ The first common mime type or 'P.Nothing' if none.
contentFormatsMatchMimeType :: ContentFormats -> ContentFormats -> m Text
contentFormatsMatchMimeType first :: ContentFormats
first second :: ContentFormats
second = 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
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
    CString
result <- Ptr ContentFormats -> Ptr ContentFormats -> IO CString
gdk_content_formats_match_mime_type Ptr ContentFormats
first' Ptr ContentFormats
second'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsMatchMimeType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
first
    ContentFormats -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr ContentFormats
second
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ContentFormatsMatchMimeTypeMethodInfo
instance (signature ~ (ContentFormats -> m T.Text), MonadIO m) => O.MethodInfo ContentFormatsMatchMimeTypeMethodInfo ContentFormats signature where
    overloadedMethod = 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 guranteed 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 :: ContentFormats -> String -> m ()
contentFormatsPrint formats :: ContentFormats
formats string :: 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.MethodInfo ContentFormatsPrintMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> m ContentFormats
contentFormatsRef formats :: 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 "contentFormatsRef" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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.MethodInfo ContentFormatsRefMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> m Text
contentFormatsToString formats :: 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
    CString
result <- Ptr ContentFormats -> IO CString
gdk_content_formats_to_string Ptr ContentFormats
formats'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsToString" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
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.MethodInfo ContentFormatsToStringMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> ContentFormats -> m ContentFormats
contentFormatsUnion first :: ContentFormats
first second :: 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, BoxedObject 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 "contentFormatsUnion" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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.MethodInfo ContentFormatsUnionMethodInfo ContentFormats signature where
    overloadedMethod = 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 = TransferNothing
--           }
--       ]
-- 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 :: ContentFormats -> m ContentFormats
contentFormatsUnionDeserializeGtypes formats :: 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_union_deserialize_gtypes Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsUnionDeserializeGtypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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.MethodInfo ContentFormatsUnionDeserializeGtypesMethodInfo ContentFormats signature where
    overloadedMethod = 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 = TransferNothing
--           }
--       ]
-- 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 :: ContentFormats -> m ContentFormats
contentFormatsUnionDeserializeMimeTypes formats :: 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_union_deserialize_mime_types Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsUnionDeserializeMimeTypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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.MethodInfo ContentFormatsUnionDeserializeMimeTypesMethodInfo ContentFormats signature where
    overloadedMethod = 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 = TransferNothing
--           }
--       ]
-- 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 :: ContentFormats -> m ContentFormats
contentFormatsUnionSerializeGtypes formats :: 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_union_serialize_gtypes Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsUnionSerializeGtypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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.MethodInfo ContentFormatsUnionSerializeGtypesMethodInfo ContentFormats signature where
    overloadedMethod = 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 = TransferNothing
--           }
--       ]
-- 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 :: ContentFormats -> m ContentFormats
contentFormatsUnionSerializeMimeTypes formats :: 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_union_serialize_mime_types Ptr ContentFormats
formats'
    Text -> Ptr ContentFormats -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contentFormatsUnionSerializeMimeTypes" Ptr ContentFormats
result
    ContentFormats
result' <- ((ManagedPtr ContentFormats -> ContentFormats)
-> Ptr ContentFormats -> IO ContentFormats
forall a.
(HasCallStack, BoxedObject 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.MethodInfo ContentFormatsUnionSerializeMimeTypesMethodInfo ContentFormats signature where
    overloadedMethod = 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 :: ContentFormats -> m ()
contentFormatsUnref formats :: 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.MethodInfo ContentFormatsUnrefMethodInfo ContentFormats signature where
    overloadedMethod = 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.MethodInfo 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

#endif