{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [free]("GI.Gst.Structs.DebugCategory#g:method:free"), [resetThreshold]("GI.Gst.Structs.DebugCategory#g:method:resetThreshold").
-- 
-- ==== Getters
-- [getColor]("GI.Gst.Structs.DebugCategory#g:method:getColor"), [getDescription]("GI.Gst.Structs.DebugCategory#g:method:getDescription"), [getName]("GI.Gst.Structs.DebugCategory#g:method:getName"), [getThreshold]("GI.Gst.Structs.DebugCategory#g:method:getThreshold").
-- 
-- ==== Setters
-- [setThreshold]("GI.Gst.Structs.DebugCategory#g:method:setThreshold").

#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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Gst.Enums as Gst.Enums

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

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

instance BoxedPtr DebugCategory where
    boxedPtrCopy :: DebugCategory -> IO DebugCategory
boxedPtrCopy = \DebugCategory
p -> DebugCategory
-> (Ptr DebugCategory -> IO DebugCategory) -> IO DebugCategory
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr DebugCategory
p (Int -> Ptr DebugCategory -> IO (Ptr DebugCategory)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
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, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr DebugCategory -> DebugCategory
DebugCategory)
    boxedPtrFree :: DebugCategory -> IO ()
boxedPtrFree = \DebugCategory
x -> DebugCategory -> (Ptr DebugCategory -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr DebugCategory
x Ptr DebugCategory -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr DebugCategory where
    boxedPtrCalloc :: IO (Ptr DebugCategory)
boxedPtrCalloc = Int -> IO (Ptr DebugCategory)
forall a. Int -> IO (Ptr a)
callocBytes Int
24


-- | Construct a `DebugCategory` struct initialized to zero.
newZeroDebugCategory :: MonadIO m => m DebugCategory
newZeroDebugCategory :: forall (m :: * -> *). MonadIO m => m DebugCategory
newZeroDebugCategory = IO DebugCategory -> m DebugCategory
forall a. IO a -> m a
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. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr DebugCategory)
-> (Ptr DebugCategory -> IO DebugCategory) -> IO DebugCategory
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr DebugCategory -> DebugCategory)
-> Ptr DebugCategory -> IO DebugCategory
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr DebugCategory -> DebugCategory
DebugCategory

instance tag ~ 'AttrSet => Constructible DebugCategory tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr DebugCategory -> DebugCategory)
-> [AttrOp DebugCategory tag] -> m DebugCategory
new ManagedPtr DebugCategory -> DebugCategory
_ [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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return DebugCategory
o



#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 ()

{-# DEPRECATED debugCategoryFree ["This function can easily cause memory corruption, don\\'t use it."] #-}
-- | 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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> m ()
debugCategoryFree DebugCategory
category = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo DebugCategoryFreeMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategoryFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> m Word32
debugCategoryGetColor DebugCategory
category = IO Word32 -> m Word32
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

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

instance O.OverloadedMethodInfo DebugCategoryGetColorMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategoryGetColor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> m Text
debugCategoryGetDescription DebugCategory
category = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    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 Text
"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 a. a -> IO a
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.OverloadedMethod DebugCategoryGetDescriptionMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetDescription

instance O.OverloadedMethodInfo DebugCategoryGetDescriptionMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategoryGetDescription",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> m Text
debugCategoryGetName DebugCategory
category = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    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 Text
"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 a. a -> IO a
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.OverloadedMethod DebugCategoryGetNameMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetName

instance O.OverloadedMethodInfo DebugCategoryGetNameMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategoryGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> m DebugLevel
debugCategoryGetThreshold DebugCategory
category = IO DebugLevel -> m DebugLevel
forall a. IO a -> m a
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 a. a -> IO a
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.OverloadedMethod DebugCategoryGetThresholdMethodInfo DebugCategory signature where
    overloadedMethod = debugCategoryGetThreshold

instance O.OverloadedMethodInfo DebugCategoryGetThresholdMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategoryGetThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> m ()
debugCategoryResetThreshold DebugCategory
category = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo DebugCategoryResetThresholdMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategoryResetThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
DebugCategory -> DebugLevel -> m ()
debugCategorySetThreshold DebugCategory
category DebugLevel
level = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo DebugCategorySetThresholdMethodInfo DebugCategory where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.DebugCategory.debugCategorySetThreshold",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-DebugCategory.html#v: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.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveDebugCategoryMethod t DebugCategory, O.OverloadedMethod info DebugCategory p, R.HasField t DebugCategory p) => R.HasField t DebugCategory p where
    getField = O.overloadedMethod @info

#endif

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

#endif