{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.NM.Structs.TCQdisc
    ( 

-- * Exported types
    TCQdisc(..)                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [dup]("GI.NM.Structs.TCQdisc#g:method:dup"), [equal]("GI.NM.Structs.TCQdisc#g:method:equal"), [ref]("GI.NM.Structs.TCQdisc#g:method:ref"), [unref]("GI.NM.Structs.TCQdisc#g:method:unref").
-- 
-- ==== Getters
-- [getAttribute]("GI.NM.Structs.TCQdisc#g:method:getAttribute"), [getAttributeNames]("GI.NM.Structs.TCQdisc#g:method:getAttributeNames"), [getHandle]("GI.NM.Structs.TCQdisc#g:method:getHandle"), [getKind]("GI.NM.Structs.TCQdisc#g:method:getKind"), [getParent]("GI.NM.Structs.TCQdisc#g:method:getParent").
-- 
-- ==== Setters
-- [setAttribute]("GI.NM.Structs.TCQdisc#g:method:setAttribute"), [setHandle]("GI.NM.Structs.TCQdisc#g:method:setHandle").

#if defined(ENABLE_OVERLOADING)
    ResolveTCQdiscMethod                    ,
#endif

-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    TCQdiscDupMethodInfo                    ,
#endif
    tCQdiscDup                              ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    TCQdiscEqualMethodInfo                  ,
#endif
    tCQdiscEqual                            ,


-- ** getAttribute #method:getAttribute#

#if defined(ENABLE_OVERLOADING)
    TCQdiscGetAttributeMethodInfo           ,
#endif
    tCQdiscGetAttribute                     ,


-- ** getAttributeNames #method:getAttributeNames#

#if defined(ENABLE_OVERLOADING)
    TCQdiscGetAttributeNamesMethodInfo      ,
#endif
    tCQdiscGetAttributeNames                ,


-- ** getHandle #method:getHandle#

#if defined(ENABLE_OVERLOADING)
    TCQdiscGetHandleMethodInfo              ,
#endif
    tCQdiscGetHandle                        ,


-- ** getKind #method:getKind#

#if defined(ENABLE_OVERLOADING)
    TCQdiscGetKindMethodInfo                ,
#endif
    tCQdiscGetKind                          ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    TCQdiscGetParentMethodInfo              ,
#endif
    tCQdiscGetParent                        ,


-- ** new #method:new#

    tCQdiscNew                              ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    TCQdiscRefMethodInfo                    ,
#endif
    tCQdiscRef                              ,


-- ** setAttribute #method:setAttribute#

#if defined(ENABLE_OVERLOADING)
    TCQdiscSetAttributeMethodInfo           ,
#endif
    tCQdiscSetAttribute                     ,


-- ** setHandle #method:setHandle#

#if defined(ENABLE_OVERLOADING)
    TCQdiscSetHandleMethodInfo              ,
#endif
    tCQdiscSetHandle                        ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TCQdiscUnrefMethodInfo                  ,
#endif
    tCQdiscUnref                            ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)

#else

#endif

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

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

foreign import ccall "nm_tc_qdisc_get_type" c_nm_tc_qdisc_get_type :: 
    IO GType

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

instance B.Types.TypedObject TCQdisc where
    glibType :: IO GType
glibType = IO GType
c_nm_tc_qdisc_get_type

instance B.Types.GBoxed TCQdisc

-- | Convert t'TCQdisc' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe TCQdisc) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_tc_qdisc_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TCQdisc -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TCQdisc
P.Nothing = Ptr GValue -> Ptr TCQdisc -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr TCQdisc
forall a. Ptr a
FP.nullPtr :: FP.Ptr TCQdisc)
    gvalueSet_ Ptr GValue
gv (P.Just TCQdisc
obj) = TCQdisc -> (Ptr TCQdisc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TCQdisc
obj (Ptr GValue -> Ptr TCQdisc -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TCQdisc)
gvalueGet_ Ptr GValue
gv = do
        Ptr TCQdisc
ptr <- Ptr GValue -> IO (Ptr TCQdisc)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr TCQdisc)
        if Ptr TCQdisc
ptr Ptr TCQdisc -> Ptr TCQdisc -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TCQdisc
forall a. Ptr a
FP.nullPtr
        then TCQdisc -> Maybe TCQdisc
forall a. a -> Maybe a
P.Just (TCQdisc -> Maybe TCQdisc) -> IO TCQdisc -> IO (Maybe TCQdisc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr TCQdisc -> TCQdisc) -> Ptr TCQdisc -> IO TCQdisc
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr TCQdisc -> TCQdisc
TCQdisc Ptr TCQdisc
ptr
        else Maybe TCQdisc -> IO (Maybe TCQdisc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TCQdisc
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TCQdisc
type instance O.AttributeList TCQdisc = TCQdiscAttributeList
type TCQdiscAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

-- method TCQdisc::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "kind"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of the queueing discipline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent queueing discipline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "TCQdisc" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_tc_qdisc_new" nm_tc_qdisc_new :: 
    CString ->                              -- kind : TBasicType TUTF8
    Word32 ->                               -- parent : TBasicType TUInt32
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TCQdisc)

-- | Creates a new t'GI.NM.Structs.TCQdisc.TCQdisc' object.
-- 
-- /Since: 1.12/
tCQdiscNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@kind@/: name of the queueing discipline
    -> Word32
    -- ^ /@parent@/: the parent queueing discipline
    -> m TCQdisc
    -- ^ __Returns:__ the new t'GI.NM.Structs.TCQdisc.TCQdisc' object, or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
tCQdiscNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Word32 -> m TCQdisc
tCQdiscNew Text
kind Word32
parent = IO TCQdisc -> m TCQdisc
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TCQdisc -> m TCQdisc) -> IO TCQdisc -> m TCQdisc
forall a b. (a -> b) -> a -> b
$ do
    CString
kind' <- Text -> IO CString
textToCString Text
kind
    IO TCQdisc -> IO () -> IO TCQdisc
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr TCQdisc
result <- (Ptr (Ptr GError) -> IO (Ptr TCQdisc)) -> IO (Ptr TCQdisc)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr TCQdisc)) -> IO (Ptr TCQdisc))
-> (Ptr (Ptr GError) -> IO (Ptr TCQdisc)) -> IO (Ptr TCQdisc)
forall a b. (a -> b) -> a -> b
$ CString -> Word32 -> Ptr (Ptr GError) -> IO (Ptr TCQdisc)
nm_tc_qdisc_new CString
kind' Word32
parent
        Text -> Ptr TCQdisc -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCQdiscNew" Ptr TCQdisc
result
        TCQdisc
result' <- ((ManagedPtr TCQdisc -> TCQdisc) -> Ptr TCQdisc -> IO TCQdisc
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TCQdisc -> TCQdisc
TCQdisc) Ptr TCQdisc
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
kind'
        TCQdisc -> IO TCQdisc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TCQdisc
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
kind'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method TCQdisc::dup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "TCQdisc" })
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_dup" nm_tc_qdisc_dup :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO (Ptr TCQdisc)

-- | Creates a copy of /@qdisc@/
-- 
-- /Since: 1.12/
tCQdiscDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m TCQdisc
    -- ^ __Returns:__ a copy of /@qdisc@/
tCQdiscDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> m TCQdisc
tCQdiscDup TCQdisc
qdisc = IO TCQdisc -> m TCQdisc
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TCQdisc -> m TCQdisc) -> IO TCQdisc -> m TCQdisc
forall a b. (a -> b) -> a -> b
$ do
    Ptr TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Ptr TCQdisc
result <- Ptr TCQdisc -> IO (Ptr TCQdisc)
nm_tc_qdisc_dup Ptr TCQdisc
qdisc'
    Text -> Ptr TCQdisc -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCQdiscDup" Ptr TCQdisc
result
    TCQdisc
result' <- ((ManagedPtr TCQdisc -> TCQdisc) -> Ptr TCQdisc -> IO TCQdisc
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TCQdisc -> TCQdisc
TCQdisc) Ptr TCQdisc
result
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    TCQdisc -> IO TCQdisc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TCQdisc
result'

#if defined(ENABLE_OVERLOADING)
data TCQdiscDupMethodInfo
instance (signature ~ (m TCQdisc), MonadIO m) => O.OverloadedMethod TCQdiscDupMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscDup

instance O.OverloadedMethodInfo TCQdiscDupMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscDup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscDup"
        })


#endif

-- method TCQdisc::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc to compare @qdisc to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_equal" nm_tc_qdisc_equal :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    Ptr TCQdisc ->                          -- other : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO CInt

-- | Determines if two t'GI.NM.Structs.TCQdisc.TCQdisc' objects contain the same kind, * handle
-- and parent.
-- 
-- /Since: 1.12/
tCQdiscEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> TCQdisc
    -- ^ /@other@/: the t'GI.NM.Structs.TCQdisc.TCQdisc' to compare /@qdisc@/ to.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the objects contain the same values, 'P.False' if they do not.
tCQdiscEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> TCQdisc -> m Bool
tCQdiscEqual TCQdisc
qdisc TCQdisc
other = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Ptr TCQdisc
other' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
other
    CInt
result <- Ptr TCQdisc -> Ptr TCQdisc -> IO CInt
nm_tc_qdisc_equal Ptr TCQdisc
qdisc' Ptr TCQdisc
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
other
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TCQdiscEqualMethodInfo
instance (signature ~ (TCQdisc -> m Bool), MonadIO m) => O.OverloadedMethod TCQdiscEqualMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscEqual

instance O.OverloadedMethodInfo TCQdiscEqualMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscEqual",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscEqual"
        })


#endif

-- method TCQdisc::get_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of an qdisc attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_get_attribute" nm_tc_qdisc_get_attribute :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Gets the value of the attribute with name /@name@/ on /@qdisc@/
-- 
-- /Since: 1.18/
tCQdiscGetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> T.Text
    -- ^ /@name@/: the name of an qdisc attribute
    -> m GVariant
    -- ^ __Returns:__ the value of the attribute with name /@name@/ on
    --   /@qdisc@/, or 'P.Nothing' if /@qdisc@/ has no such attribute.
tCQdiscGetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> Text -> m GVariant
tCQdiscGetAttribute TCQdisc
qdisc Text
name = IO GVariant -> m GVariant
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
result <- Ptr TCQdisc -> CString -> IO (Ptr GVariant)
nm_tc_qdisc_get_attribute Ptr TCQdisc
qdisc' CString
name'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCQdiscGetAttribute" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    GVariant -> IO GVariant
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data TCQdiscGetAttributeMethodInfo
instance (signature ~ (T.Text -> m GVariant), MonadIO m) => O.OverloadedMethod TCQdiscGetAttributeMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscGetAttribute

instance O.OverloadedMethodInfo TCQdiscGetAttributeMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscGetAttribute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscGetAttribute"
        })


#endif

-- method TCQdisc::get_attribute_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_get_attribute_names" nm_tc_qdisc_get_attribute_names :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO (Ptr CString)

-- | Gets an array of attribute names defined on /@qdisc@/.
-- 
-- /Since: 1.18/
tCQdiscGetAttributeNames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of attribute names
    --   or 'P.Nothing' if no attributes are set.
tCQdiscGetAttributeNames :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> m [Text]
tCQdiscGetAttributeNames TCQdisc
qdisc = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Ptr CString
result <- Ptr TCQdisc -> IO (Ptr CString)
nm_tc_qdisc_get_attribute_names Ptr TCQdisc
qdisc'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCQdiscGetAttributeNames" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data TCQdiscGetAttributeNamesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod TCQdiscGetAttributeNamesMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscGetAttributeNames

instance O.OverloadedMethodInfo TCQdiscGetAttributeNamesMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscGetAttributeNames",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscGetAttributeNames"
        })


#endif

-- method TCQdisc::get_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_get_handle" nm_tc_qdisc_get_handle :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO Word32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.12/
tCQdiscGetHandle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m Word32
    -- ^ __Returns:__ the queueing discipline handle
tCQdiscGetHandle :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> m Word32
tCQdiscGetHandle TCQdisc
qdisc = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Word32
result <- Ptr TCQdisc -> IO Word32
nm_tc_qdisc_get_handle Ptr TCQdisc
qdisc'
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TCQdiscGetHandleMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod TCQdiscGetHandleMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscGetHandle

instance O.OverloadedMethodInfo TCQdiscGetHandleMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscGetHandle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscGetHandle"
        })


#endif

-- method TCQdisc::get_kind
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_get_kind" nm_tc_qdisc_get_kind :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO CString

-- | /No description available in the introspection data./
-- 
-- /Since: 1.12/
tCQdiscGetKind ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m T.Text
tCQdiscGetKind :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> m Text
tCQdiscGetKind TCQdisc
qdisc = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    CString
result <- Ptr TCQdisc -> IO CString
nm_tc_qdisc_get_kind Ptr TCQdisc
qdisc'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCQdiscGetKind" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data TCQdiscGetKindMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TCQdiscGetKindMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscGetKind

instance O.OverloadedMethodInfo TCQdiscGetKindMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscGetKind",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscGetKind"
        })


#endif

-- method TCQdisc::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt32)
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_get_parent" nm_tc_qdisc_get_parent :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO Word32

-- | /No description available in the introspection data./
-- 
-- /Since: 1.12/
tCQdiscGetParent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m Word32
    -- ^ __Returns:__ the parent class
tCQdiscGetParent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> m Word32
tCQdiscGetParent TCQdisc
qdisc = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Word32
result <- Ptr TCQdisc -> IO Word32
nm_tc_qdisc_get_parent Ptr TCQdisc
qdisc'
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TCQdiscGetParentMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod TCQdiscGetParentMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscGetParent

instance O.OverloadedMethodInfo TCQdiscGetParentMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscGetParent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscGetParent"
        })


#endif

-- method TCQdisc::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_ref" nm_tc_qdisc_ref :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO ()

-- | Increases the reference count of the object.
-- 
-- /Since: 1.12/
tCQdiscRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m ()
tCQdiscRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => TCQdisc -> m ()
tCQdiscRef TCQdisc
qdisc = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Ptr TCQdisc -> IO ()
nm_tc_qdisc_ref Ptr TCQdisc
qdisc'
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TCQdiscRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TCQdiscRefMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscRef

instance O.OverloadedMethodInfo TCQdiscRefMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscRef"
        })


#endif

-- method TCQdisc::set_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of an qdisc attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_set_attribute" nm_tc_qdisc_set_attribute :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Sets or clears the named attribute on /@qdisc@/ to the given value.
-- 
-- /Since: 1.18/
tCQdiscSetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> T.Text
    -- ^ /@name@/: the name of an qdisc attribute
    -> Maybe (GVariant)
    -- ^ /@value@/: the value
    -> m ()
tCQdiscSetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> Text -> Maybe GVariant -> m ()
tCQdiscSetAttribute TCQdisc
qdisc Text
name Maybe GVariant
value = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
maybeValue <- case Maybe GVariant
value of
        Maybe GVariant
Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
FP.nullPtr
        Just GVariant
jValue -> do
            Ptr GVariant
jValue' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jValue
            Ptr GVariant -> IO (Ptr GVariant)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jValue'
    Ptr TCQdisc -> CString -> Ptr GVariant -> IO ()
nm_tc_qdisc_set_attribute Ptr TCQdisc
qdisc' CString
name' Ptr GVariant
maybeValue
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
value GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TCQdiscSetAttributeMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> m ()), MonadIO m) => O.OverloadedMethod TCQdiscSetAttributeMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscSetAttribute

instance O.OverloadedMethodInfo TCQdiscSetAttributeMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscSetAttribute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscSetAttribute"
        })


#endif

-- method TCQdisc::set_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "qdisc"
--           , argType = TInterface Name { namespace = "NM" , name = "TCQdisc" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCQdisc" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "handle"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the queueing discipline handle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "nm_tc_qdisc_set_handle" nm_tc_qdisc_set_handle :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    Word32 ->                               -- handle : TBasicType TUInt32
    IO ()

-- | Sets the queueing discipline handle.
-- 
-- /Since: 1.12/
tCQdiscSetHandle ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> Word32
    -- ^ /@handle@/: the queueing discipline handle
    -> m ()
tCQdiscSetHandle :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCQdisc -> Word32 -> m ()
tCQdiscSetHandle TCQdisc
qdisc Word32
handle = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Ptr TCQdisc -> Word32 -> IO ()
nm_tc_qdisc_set_handle Ptr TCQdisc
qdisc' Word32
handle
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TCQdiscSetHandleMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod TCQdiscSetHandleMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscSetHandle

instance O.OverloadedMethodInfo TCQdiscSetHandleMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscSetHandle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscSetHandle"
        })


#endif

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

foreign import ccall "nm_tc_qdisc_unref" nm_tc_qdisc_unref :: 
    Ptr TCQdisc ->                          -- qdisc : TInterface (Name {namespace = "NM", name = "TCQdisc"})
    IO ()

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero, the object will be destroyed.
-- 
-- /Since: 1.12/
tCQdiscUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCQdisc
    -- ^ /@qdisc@/: the t'GI.NM.Structs.TCQdisc.TCQdisc'
    -> m ()
tCQdiscUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => TCQdisc -> m ()
tCQdiscUnref TCQdisc
qdisc = 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 TCQdisc
qdisc' <- TCQdisc -> IO (Ptr TCQdisc)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCQdisc
qdisc
    Ptr TCQdisc -> IO ()
nm_tc_qdisc_unref Ptr TCQdisc
qdisc'
    TCQdisc -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCQdisc
qdisc
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TCQdiscUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TCQdiscUnrefMethodInfo TCQdisc signature where
    overloadedMethod = tCQdiscUnref

instance O.OverloadedMethodInfo TCQdiscUnrefMethodInfo TCQdisc where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.NM.Structs.TCQdisc.tCQdiscUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-nm-1.0.1/docs/GI-NM-Structs-TCQdisc.html#v:tCQdiscUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTCQdiscMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTCQdiscMethod "dup" o = TCQdiscDupMethodInfo
    ResolveTCQdiscMethod "equal" o = TCQdiscEqualMethodInfo
    ResolveTCQdiscMethod "ref" o = TCQdiscRefMethodInfo
    ResolveTCQdiscMethod "unref" o = TCQdiscUnrefMethodInfo
    ResolveTCQdiscMethod "getAttribute" o = TCQdiscGetAttributeMethodInfo
    ResolveTCQdiscMethod "getAttributeNames" o = TCQdiscGetAttributeNamesMethodInfo
    ResolveTCQdiscMethod "getHandle" o = TCQdiscGetHandleMethodInfo
    ResolveTCQdiscMethod "getKind" o = TCQdiscGetKindMethodInfo
    ResolveTCQdiscMethod "getParent" o = TCQdiscGetParentMethodInfo
    ResolveTCQdiscMethod "setAttribute" o = TCQdiscSetAttributeMethodInfo
    ResolveTCQdiscMethod "setHandle" o = TCQdiscSetHandleMethodInfo
    ResolveTCQdiscMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif