{-# 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.TCTfilter
    ( 

-- * Exported types
    TCTfilter(..)                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTCTfilterMethod                  ,
#endif

-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    TCTfilterDupMethodInfo                  ,
#endif
    tCTfilterDup                            ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    TCTfilterEqualMethodInfo                ,
#endif
    tCTfilterEqual                          ,


-- ** getAction #method:getAction#

#if defined(ENABLE_OVERLOADING)
    TCTfilterGetActionMethodInfo            ,
#endif
    tCTfilterGetAction                      ,


-- ** getHandle #method:getHandle#

#if defined(ENABLE_OVERLOADING)
    TCTfilterGetHandleMethodInfo            ,
#endif
    tCTfilterGetHandle                      ,


-- ** getKind #method:getKind#

#if defined(ENABLE_OVERLOADING)
    TCTfilterGetKindMethodInfo              ,
#endif
    tCTfilterGetKind                        ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    TCTfilterGetParentMethodInfo            ,
#endif
    tCTfilterGetParent                      ,


-- ** new #method:new#

    tCTfilterNew                            ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    TCTfilterRefMethodInfo                  ,
#endif
    tCTfilterRef                            ,


-- ** setAction #method:setAction#

#if defined(ENABLE_OVERLOADING)
    TCTfilterSetActionMethodInfo            ,
#endif
    tCTfilterSetAction                      ,


-- ** setHandle #method:setHandle#

#if defined(ENABLE_OVERLOADING)
    TCTfilterSetHandleMethodInfo            ,
#endif
    tCTfilterSetHandle                      ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TCTfilterUnrefMethodInfo                ,
#endif
    tCTfilterUnref                          ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import {-# SOURCE #-} qualified GI.NM.Structs.TCAction as NM.TCAction

#else
import {-# SOURCE #-} qualified GI.NM.Structs.TCAction as NM.TCAction

#endif

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

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

foreign import ccall "nm_tc_tfilter_get_type" c_nm_tc_tfilter_get_type :: 
    IO GType

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

instance B.Types.TypedObject TCTfilter where
    glibType :: IO GType
glibType = IO GType
c_nm_tc_tfilter_get_type

instance B.Types.GBoxed TCTfilter

-- | Convert t'TCTfilter' 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 TCTfilter) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_nm_tc_tfilter_get_type
    gvalueSet_ :: Ptr GValue -> Maybe TCTfilter -> IO ()
gvalueSet_ Ptr GValue
gv Maybe TCTfilter
P.Nothing = Ptr GValue -> Ptr TCTfilter -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr TCTfilter
forall a. Ptr a
FP.nullPtr :: FP.Ptr TCTfilter)
    gvalueSet_ Ptr GValue
gv (P.Just TCTfilter
obj) = TCTfilter -> (Ptr TCTfilter -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr TCTfilter
obj (Ptr GValue -> Ptr TCTfilter -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe TCTfilter)
gvalueGet_ Ptr GValue
gv = do
        Ptr TCTfilter
ptr <- Ptr GValue -> IO (Ptr TCTfilter)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr TCTfilter)
        if Ptr TCTfilter
ptr Ptr TCTfilter -> Ptr TCTfilter -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr TCTfilter
forall a. Ptr a
FP.nullPtr
        then TCTfilter -> Maybe TCTfilter
forall a. a -> Maybe a
P.Just (TCTfilter -> Maybe TCTfilter)
-> IO TCTfilter -> IO (Maybe TCTfilter)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr TCTfilter -> TCTfilter)
-> Ptr TCTfilter -> IO TCTfilter
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr TCTfilter -> TCTfilter
TCTfilter Ptr TCTfilter
ptr
        else Maybe TCTfilter -> IO (Maybe TCTfilter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TCTfilter
forall a. Maybe a
P.Nothing
        
    


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

-- method TCTfilter::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 = "TCTfilter" })
-- throws : True
-- Skip return : False

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

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

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "nm_tc_tfilter_dup" nm_tc_tfilter_dup :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO (Ptr TCTfilter)

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterDupMethodInfo
instance (signature ~ (m TCTfilter), MonadIO m) => O.OverloadedMethod TCTfilterDupMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterDup

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


#endif

-- method TCTfilter::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter to compare @tfilter 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_tfilter_equal" nm_tc_tfilter_equal :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    Ptr TCTfilter ->                        -- other : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO CInt

-- | Determines if two t'GI.NM.Structs.TCTfilter.TCTfilter' objects contain the same kind, family,
-- handle, parent and info.
-- 
-- /Since: 1.12/
tCTfilterEqual ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCTfilter
    -- ^ /@tfilter@/: the t'GI.NM.Structs.TCTfilter.TCTfilter'
    -> TCTfilter
    -- ^ /@other@/: the t'GI.NM.Structs.TCTfilter.TCTfilter' to compare /@tfilter@/ to.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the objects contain the same values, 'P.False' if they do not.
tCTfilterEqual :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCTfilter -> TCTfilter -> m Bool
tCTfilterEqual TCTfilter
tfilter TCTfilter
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 TCTfilter
tfilter' <- TCTfilter -> IO (Ptr TCTfilter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCTfilter
tfilter
    Ptr TCTfilter
other' <- TCTfilter -> IO (Ptr TCTfilter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCTfilter
other
    CInt
result <- Ptr TCTfilter -> Ptr TCTfilter -> IO CInt
nm_tc_tfilter_equal Ptr TCTfilter
tfilter' Ptr TCTfilter
other'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    TCTfilter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCTfilter
tfilter
    TCTfilter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCTfilter
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 TCTfilterEqualMethodInfo
instance (signature ~ (TCTfilter -> m Bool), MonadIO m) => O.OverloadedMethod TCTfilterEqualMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterEqual

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


#endif

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

foreign import ccall "nm_tc_tfilter_get_action" nm_tc_tfilter_get_action :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO (Ptr NM.TCAction.TCAction)

-- | /No description available in the introspection data./
-- 
-- /Since: 1.42/
tCTfilterGetAction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCTfilter
    -- ^ /@tfilter@/: the t'GI.NM.Structs.TCTfilter.TCTfilter'
    -> m NM.TCAction.TCAction
    -- ^ __Returns:__ the action associated with a traffic filter.
tCTfilterGetAction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCTfilter -> m TCAction
tCTfilterGetAction TCTfilter
tfilter = IO TCAction -> m TCAction
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TCAction -> m TCAction) -> IO TCAction -> m TCAction
forall a b. (a -> b) -> a -> b
$ do
    Ptr TCTfilter
tfilter' <- TCTfilter -> IO (Ptr TCTfilter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCTfilter
tfilter
    Ptr TCAction
result <- Ptr TCTfilter -> IO (Ptr TCAction)
nm_tc_tfilter_get_action Ptr TCTfilter
tfilter'
    Text -> Ptr TCAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCTfilterGetAction" Ptr TCAction
result
    TCAction
result' <- ((ManagedPtr TCAction -> TCAction) -> Ptr TCAction -> IO TCAction
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr TCAction -> TCAction
NM.TCAction.TCAction) Ptr TCAction
result
    TCTfilter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCTfilter
tfilter
    TCAction -> IO TCAction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TCAction
result'

#if defined(ENABLE_OVERLOADING)
data TCTfilterGetActionMethodInfo
instance (signature ~ (m NM.TCAction.TCAction), MonadIO m) => O.OverloadedMethod TCTfilterGetActionMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterGetAction

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


#endif

-- method TCTfilter::get_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , 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_tfilter_get_handle" nm_tc_tfilter_get_handle :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO Word32

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterGetHandleMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod TCTfilterGetHandleMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterGetHandle

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


#endif

-- method TCTfilter::get_kind
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , 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_tfilter_get_kind" nm_tc_tfilter_get_kind :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO CString

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterGetKindMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TCTfilterGetKindMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterGetKind

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


#endif

-- method TCTfilter::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , 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_tfilter_get_parent" nm_tc_tfilter_get_parent :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO Word32

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterGetParentMethodInfo
instance (signature ~ (m Word32), MonadIO m) => O.OverloadedMethod TCTfilterGetParentMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterGetParent

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


#endif

-- method TCTfilter::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , 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_tfilter_ref" nm_tc_tfilter_ref :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TCTfilterRefMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterRef

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


#endif

-- method TCTfilter::set_action
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the action object" , 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_tfilter_set_action" nm_tc_tfilter_set_action :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    Ptr NM.TCAction.TCAction ->             -- action : TInterface (Name {namespace = "NM", name = "TCAction"})
    IO ()

-- | Sets the action associated with a traffic filter.
-- 
-- /Since: 1.42/
tCTfilterSetAction ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCTfilter
    -- ^ /@tfilter@/: the t'GI.NM.Structs.TCTfilter.TCTfilter'
    -> NM.TCAction.TCAction
    -- ^ /@action@/: the action object
    -> m ()
tCTfilterSetAction :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCTfilter -> TCAction -> m ()
tCTfilterSetAction TCTfilter
tfilter TCAction
action = 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 TCTfilter
tfilter' <- TCTfilter -> IO (Ptr TCTfilter)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCTfilter
tfilter
    Ptr TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    Ptr TCTfilter -> Ptr TCAction -> IO ()
nm_tc_tfilter_set_action Ptr TCTfilter
tfilter' Ptr TCAction
action'
    TCTfilter -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCTfilter
tfilter
    TCAction -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCAction
action
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TCTfilterSetActionMethodInfo
instance (signature ~ (NM.TCAction.TCAction -> m ()), MonadIO m) => O.OverloadedMethod TCTfilterSetActionMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterSetAction

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


#endif

-- method TCTfilter::set_handle
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , 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_tfilter_set_handle" nm_tc_tfilter_set_handle :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    Word32 ->                               -- handle : TBasicType TUInt32
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterSetHandleMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m) => O.OverloadedMethod TCTfilterSetHandleMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterSetHandle

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


#endif

-- method TCTfilter::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "tfilter"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCTfilter" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCTfilter" , 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_tfilter_unref" nm_tc_tfilter_unref :: 
    Ptr TCTfilter ->                        -- tfilter : TInterface (Name {namespace = "NM", name = "TCTfilter"})
    IO ()

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

#if defined(ENABLE_OVERLOADING)
data TCTfilterUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TCTfilterUnrefMethodInfo TCTfilter signature where
    overloadedMethod = tCTfilterUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTCTfilterMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTCTfilterMethod "dup" o = TCTfilterDupMethodInfo
    ResolveTCTfilterMethod "equal" o = TCTfilterEqualMethodInfo
    ResolveTCTfilterMethod "ref" o = TCTfilterRefMethodInfo
    ResolveTCTfilterMethod "unref" o = TCTfilterUnrefMethodInfo
    ResolveTCTfilterMethod "getAction" o = TCTfilterGetActionMethodInfo
    ResolveTCTfilterMethod "getHandle" o = TCTfilterGetHandleMethodInfo
    ResolveTCTfilterMethod "getKind" o = TCTfilterGetKindMethodInfo
    ResolveTCTfilterMethod "getParent" o = TCTfilterGetParentMethodInfo
    ResolveTCTfilterMethod "setAction" o = TCTfilterSetActionMethodInfo
    ResolveTCTfilterMethod "setHandle" o = TCTfilterSetHandleMethodInfo
    ResolveTCTfilterMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif