{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- This is the struct that describes the categories. Once initialized with
-- @/GST_DEBUG_CATEGORY_INIT/@, its values can\'t be changed anymore.

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

module GI.Gst.Structs.DebugCategory
    ( 

-- * Exported types
    DebugCategory(..)                       ,
    newZeroDebugCategory                    ,
    noDebugCategory                         ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveDebugCategoryMethod              ,
#endif


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    DebugCategoryFreeMethodInfo             ,
#endif
    debugCategoryFree                       ,


-- ** getColor #method:getColor#

#if defined(ENABLE_OVERLOADING)
    DebugCategoryGetColorMethodInfo         ,
#endif
    debugCategoryGetColor                   ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    DebugCategoryGetDescriptionMethodInfo   ,
#endif
    debugCategoryGetDescription             ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    DebugCategoryGetNameMethodInfo          ,
#endif
    debugCategoryGetName                    ,


-- ** getThreshold #method:getThreshold#

#if defined(ENABLE_OVERLOADING)
    DebugCategoryGetThresholdMethodInfo     ,
#endif
    debugCategoryGetThreshold               ,


-- ** resetThreshold #method:resetThreshold#

#if defined(ENABLE_OVERLOADING)
    DebugCategoryResetThresholdMethodInfo   ,
#endif
    debugCategoryResetThreshold             ,


-- ** setThreshold #method:setThreshold#

#if defined(ENABLE_OVERLOADING)
    DebugCategorySetThresholdMethodInfo     ,
#endif
    debugCategorySetThreshold               ,




    ) 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 {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums

-- | Memory-managed wrapper type.
newtype DebugCategory = DebugCategory (ManagedPtr DebugCategory)
    deriving (DebugCategory -> DebugCategory -> Bool
(DebugCategory -> DebugCategory -> Bool)
-> (DebugCategory -> DebugCategory -> Bool) -> Eq DebugCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugCategory -> DebugCategory -> Bool
$c/= :: DebugCategory -> DebugCategory -> Bool
== :: DebugCategory -> DebugCategory -> Bool
$c== :: DebugCategory -> DebugCategory -> Bool
Eq)
instance WrappedPtr DebugCategory where
    wrappedPtrCalloc :: IO (Ptr DebugCategory)
wrappedPtrCalloc = Int -> IO (Ptr DebugCategory)
forall a. Int -> IO (Ptr a)
callocBytes 24
    wrappedPtrCopy :: DebugCategory -> IO DebugCategory
wrappedPtrCopy = \p :: DebugCategory
p -> DebugCategory
-> (Ptr DebugCategory -> IO DebugCategory) -> IO DebugCategory
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr DebugCategory
p (Int -> Ptr DebugCategory -> IO (Ptr DebugCategory)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 24 (Ptr DebugCategory -> IO (Ptr DebugCategory))
-> (Ptr DebugCategory -> IO DebugCategory)
-> Ptr DebugCategory
-> IO DebugCategory
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr DebugCategory -> DebugCategory)
-> Ptr DebugCategory -> IO DebugCategory
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr DebugCategory -> DebugCategory
DebugCategory)
    wrappedPtrFree :: Maybe (GDestroyNotify DebugCategory)
wrappedPtrFree = GDestroyNotify DebugCategory
-> Maybe (GDestroyNotify DebugCategory)
forall a. a -> Maybe a
Just GDestroyNotify DebugCategory
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `DebugCategory` struct initialized to zero.
newZeroDebugCategory :: MonadIO m => m DebugCategory
newZeroDebugCategory :: m DebugCategory
newZeroDebugCategory = IO DebugCategory -> m DebugCategory
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DebugCategory -> m DebugCategory)
-> IO DebugCategory -> m DebugCategory
forall a b. (a -> b) -> a -> b
$ IO (Ptr DebugCategory)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr DebugCategory)
-> (Ptr DebugCategory -> IO DebugCategory) -> IO DebugCategory
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr DebugCategory -> DebugCategory)
-> Ptr DebugCategory -> IO DebugCategory
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr DebugCategory -> DebugCategory
DebugCategory

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


-- | A convenience alias for `Nothing` :: `Maybe` `DebugCategory`.
noDebugCategory :: Maybe DebugCategory
noDebugCategory :: Maybe DebugCategory
noDebugCategory = Maybe DebugCategory
forall a. Maybe a
Nothing


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

-- method DebugCategory::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GstDebugCategory to free."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_debug_category_free" gst_debug_category_free :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    IO ()

-- | Removes and frees the category and all associated resources.
debugCategoryFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: t'GI.Gst.Structs.DebugCategory.DebugCategory' to free.
    -> m ()
debugCategoryFree :: DebugCategory -> m ()
debugCategoryFree category :: DebugCategory
category = 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 DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    Ptr DebugCategory -> IO ()
gst_debug_category_free Ptr DebugCategory
category'
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DebugCategoryFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DebugCategoryFreeMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryFree

#endif

-- method DebugCategory::get_color
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDebugCategory to get the color of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "gst_debug_category_get_color" gst_debug_category_get_color :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    IO Word32

-- | Returns the color of a debug category used when printing output in this
-- category.
debugCategoryGetColor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: a t'GI.Gst.Structs.DebugCategory.DebugCategory' to get the color of.
    -> m Word32
    -- ^ __Returns:__ the color of the category.
debugCategoryGetColor :: DebugCategory -> m Word32
debugCategoryGetColor category :: DebugCategory
category = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    Word32
result <- Ptr DebugCategory -> IO Word32
gst_debug_category_get_color Ptr DebugCategory
category'
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data DebugCategoryGetColorMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.MethodInfo DebugCategoryGetColorMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetColor

#endif

-- method DebugCategory::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GstDebugCategory to get the description of."
--                 , 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 "gst_debug_category_get_description" gst_debug_category_get_description :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    IO CString

-- | Returns the description of a debug category.
debugCategoryGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: a t'GI.Gst.Structs.DebugCategory.DebugCategory' to get the description of.
    -> m T.Text
    -- ^ __Returns:__ the description of the category.
debugCategoryGetDescription :: DebugCategory -> m Text
debugCategoryGetDescription category :: DebugCategory
category = 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 DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    CString
result <- Ptr DebugCategory -> IO CString
gst_debug_category_get_description Ptr DebugCategory
category'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "debugCategoryGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DebugCategoryGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo DebugCategoryGetDescriptionMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetDescription

#endif

-- method DebugCategory::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDebugCategory to get name of."
--                 , 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 "gst_debug_category_get_name" gst_debug_category_get_name :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    IO CString

-- | Returns the name of a debug category.
debugCategoryGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: a t'GI.Gst.Structs.DebugCategory.DebugCategory' to get name of.
    -> m T.Text
    -- ^ __Returns:__ the name of the category.
debugCategoryGetName :: DebugCategory -> m Text
debugCategoryGetName category :: DebugCategory
category = 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 DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    CString
result <- Ptr DebugCategory -> IO CString
gst_debug_category_get_name Ptr DebugCategory
category'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "debugCategoryGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data DebugCategoryGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo DebugCategoryGetNameMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetName

#endif

-- method DebugCategory::get_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDebugCategory to get threshold of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "DebugLevel" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_debug_category_get_threshold" gst_debug_category_get_threshold :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    IO CUInt

-- | Returns the threshold of a t'GI.Gst.Structs.DebugCategory.DebugCategory'.
debugCategoryGetThreshold ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: a t'GI.Gst.Structs.DebugCategory.DebugCategory' to get threshold of.
    -> m Gst.Enums.DebugLevel
    -- ^ __Returns:__ the t'GI.Gst.Enums.DebugLevel' that is used as threshold.
debugCategoryGetThreshold :: DebugCategory -> m DebugLevel
debugCategoryGetThreshold category :: DebugCategory
category = IO DebugLevel -> m DebugLevel
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DebugLevel -> m DebugLevel) -> IO DebugLevel -> m DebugLevel
forall a b. (a -> b) -> a -> b
$ do
    Ptr DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    CUInt
result <- Ptr DebugCategory -> IO CUInt
gst_debug_category_get_threshold Ptr DebugCategory
category'
    let result' :: DebugLevel
result' = (Int -> DebugLevel
forall a. Enum a => Int -> a
toEnum (Int -> DebugLevel) -> (CUInt -> Int) -> CUInt -> DebugLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    DebugLevel -> IO DebugLevel
forall (m :: * -> *) a. Monad m => a -> m a
return DebugLevel
result'

#if defined(ENABLE_OVERLOADING)
data DebugCategoryGetThresholdMethodInfo
instance (signature ~ (m Gst.Enums.DebugLevel), MonadIO m) => O.MethodInfo DebugCategoryGetThresholdMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetThreshold

#endif

-- method DebugCategory::reset_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDebugCategory to reset threshold of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_debug_category_reset_threshold" gst_debug_category_reset_threshold :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    IO ()

-- | Resets the threshold of the category to the default level. Debug information
-- will only be output if the threshold is lower or equal to the level of the
-- debugging message.
-- Use this function to set the threshold back to where it was after using
-- 'GI.Gst.Structs.DebugCategory.debugCategorySetThreshold'.
debugCategoryResetThreshold ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: a t'GI.Gst.Structs.DebugCategory.DebugCategory' to reset threshold of.
    -> m ()
debugCategoryResetThreshold :: DebugCategory -> m ()
debugCategoryResetThreshold category :: DebugCategory
category = 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 DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    Ptr DebugCategory -> IO ()
gst_debug_category_reset_threshold Ptr DebugCategory
category'
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DebugCategoryResetThresholdMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo DebugCategoryResetThresholdMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryResetThreshold

#endif

-- method DebugCategory::set_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "category"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugCategory" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GstDebugCategory to set threshold of."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "DebugLevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GstDebugLevel threshold to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_debug_category_set_threshold" gst_debug_category_set_threshold :: 
    Ptr DebugCategory ->                    -- category : TInterface (Name {namespace = "Gst", name = "DebugCategory"})
    CUInt ->                                -- level : TInterface (Name {namespace = "Gst", name = "DebugLevel"})
    IO ()

-- | Sets the threshold of the category to the given level. Debug information will
-- only be output if the threshold is lower or equal to the level of the
-- debugging message.
-- > Do not use this function in production code, because other functions may
-- > change the threshold of categories as side effect. It is however a nice
-- > function to use when debugging (even from gdb).
debugCategorySetThreshold ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    DebugCategory
    -- ^ /@category@/: a t'GI.Gst.Structs.DebugCategory.DebugCategory' to set threshold of.
    -> Gst.Enums.DebugLevel
    -- ^ /@level@/: the t'GI.Gst.Enums.DebugLevel' threshold to set.
    -> m ()
debugCategorySetThreshold :: DebugCategory -> DebugLevel -> m ()
debugCategorySetThreshold category :: DebugCategory
category level :: DebugLevel
level = 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 DebugCategory
category' <- DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr DebugCategory
category
    let level' :: CUInt
level' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (DebugLevel -> Int) -> DebugLevel -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DebugLevel -> Int
forall a. Enum a => a -> Int
fromEnum) DebugLevel
level
    Ptr DebugCategory -> CUInt -> IO ()
gst_debug_category_set_threshold Ptr DebugCategory
category' CUInt
level'
    DebugCategory -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr DebugCategory
category
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DebugCategorySetThresholdMethodInfo
instance (signature ~ (Gst.Enums.DebugLevel -> m ()), MonadIO m) => O.MethodInfo DebugCategorySetThresholdMethodInfo DebugCategory signature where
    overloadedMethod = debugCategorySetThreshold

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveDebugCategoryMethod (t :: Symbol) (o :: *) :: * where
    ResolveDebugCategoryMethod "free" o = DebugCategoryFreeMethodInfo
    ResolveDebugCategoryMethod "resetThreshold" o = DebugCategoryResetThresholdMethodInfo
    ResolveDebugCategoryMethod "getColor" o = DebugCategoryGetColorMethodInfo
    ResolveDebugCategoryMethod "getDescription" o = DebugCategoryGetDescriptionMethodInfo
    ResolveDebugCategoryMethod "getName" o = DebugCategoryGetNameMethodInfo
    ResolveDebugCategoryMethod "getThreshold" o = DebugCategoryGetThresholdMethodInfo
    ResolveDebugCategoryMethod "setThreshold" o = DebugCategorySetThresholdMethodInfo
    ResolveDebugCategoryMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveDebugCategoryMethod t DebugCategory, O.MethodInfo info DebugCategory p) => OL.IsLabel t (DebugCategory -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif