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

-- * Exported types
    TCAction(..)                            ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveTCActionMethod                   ,
#endif

-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    TCActionDupMethodInfo                   ,
#endif
    tCActionDup                             ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    TCActionEqualMethodInfo                 ,
#endif
    tCActionEqual                           ,


-- ** getAttribute #method:getAttribute#

#if defined(ENABLE_OVERLOADING)
    TCActionGetAttributeMethodInfo          ,
#endif
    tCActionGetAttribute                    ,


-- ** getAttributeNames #method:getAttributeNames#

#if defined(ENABLE_OVERLOADING)
    TCActionGetAttributeNamesMethodInfo     ,
#endif
    tCActionGetAttributeNames               ,


-- ** getKind #method:getKind#

#if defined(ENABLE_OVERLOADING)
    TCActionGetKindMethodInfo               ,
#endif
    tCActionGetKind                         ,


-- ** new #method:new#

    tCActionNew                             ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    TCActionRefMethodInfo                   ,
#endif
    tCActionRef                             ,


-- ** setAttribute #method:setAttribute#

#if defined(ENABLE_OVERLOADING)
    TCActionSetAttributeMethodInfo          ,
#endif
    tCActionSetAttribute                    ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    TCActionUnrefMethodInfo                 ,
#endif
    tCActionUnref                           ,




    ) 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 TCAction = TCAction (SP.ManagedPtr TCAction)
    deriving (TCAction -> TCAction -> Bool
(TCAction -> TCAction -> Bool)
-> (TCAction -> TCAction -> Bool) -> Eq TCAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TCAction -> TCAction -> Bool
== :: TCAction -> TCAction -> Bool
$c/= :: TCAction -> TCAction -> Bool
/= :: TCAction -> TCAction -> Bool
Eq)

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

foreign import ccall "nm_tc_action_get_type" c_nm_tc_action_get_type :: 
    IO GType

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

instance B.Types.TypedObject TCAction where
    glibType :: IO GType
glibType = IO GType
c_nm_tc_action_get_type

instance B.Types.GBoxed TCAction

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


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

-- method TCAction::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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "NM" , name = "TCAction" })
-- throws : True
-- Skip return : False

foreign import ccall "nm_tc_action_new" nm_tc_action_new :: 
    CString ->                              -- kind : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr TCAction)

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

#if defined(ENABLE_OVERLOADING)
#endif

-- method TCAction::dup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCAction" , 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_action_dup" nm_tc_action_dup :: 
    Ptr TCAction ->                         -- action : TInterface (Name {namespace = "NM", name = "TCAction"})
    IO (Ptr TCAction)

-- | Creates a copy of /@action@/
-- 
-- /Since: 1.12/
tCActionDup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCAction
    -- ^ /@action@/: the t'GI.NM.Structs.TCAction.TCAction'
    -> m TCAction
    -- ^ __Returns:__ a copy of /@action@/
tCActionDup :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCAction -> m TCAction
tCActionDup TCAction
action = 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 TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    Ptr TCAction
result <- Ptr TCAction -> IO (Ptr TCAction)
nm_tc_action_dup Ptr TCAction
action'
    Text -> Ptr TCAction -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCActionDup" 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
TCAction) Ptr TCAction
result
    TCAction -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCAction
action
    TCAction -> IO TCAction
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TCAction
result'

#if defined(ENABLE_OVERLOADING)
data TCActionDupMethodInfo
instance (signature ~ (m TCAction), MonadIO m) => O.OverloadedMethod TCActionDupMethodInfo TCAction signature where
    overloadedMethod = tCActionDup

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


#endif

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

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

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


#endif

-- method TCAction::get_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCAction" , 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 action 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_action_get_attribute" nm_tc_action_get_attribute :: 
    Ptr TCAction ->                         -- action : TInterface (Name {namespace = "NM", name = "TCAction"})
    CString ->                              -- name : TBasicType TUTF8
    IO (Ptr GVariant)

-- | Gets the value of the attribute with name /@name@/ on /@action@/
-- 
-- /Since: 1.12/
tCActionGetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCAction
    -- ^ /@action@/: the t'GI.NM.Structs.TCAction.TCAction'
    -> T.Text
    -- ^ /@name@/: the name of an action attribute
    -> m GVariant
    -- ^ __Returns:__ the value of the attribute with name /@name@/ on
    --   /@action@/, or 'P.Nothing' if /@action@/ has no such attribute.
tCActionGetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCAction -> Text -> m GVariant
tCActionGetAttribute TCAction
action 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 TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
result <- Ptr TCAction -> CString -> IO (Ptr GVariant)
nm_tc_action_get_attribute Ptr TCAction
action' CString
name'
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCActionGetAttribute" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result
    TCAction -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCAction
action
    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 TCActionGetAttributeMethodInfo
instance (signature ~ (T.Text -> m GVariant), MonadIO m) => O.OverloadedMethod TCActionGetAttributeMethodInfo TCAction signature where
    overloadedMethod = tCActionGetAttribute

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


#endif

-- method TCAction::get_attribute_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCAction" , 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_action_get_attribute_names" nm_tc_action_get_attribute_names :: 
    Ptr TCAction ->                         -- action : TInterface (Name {namespace = "NM", name = "TCAction"})
    IO (Ptr CString)

-- | Gets an array of attribute names defined on /@action@/.
-- 
-- /Since: 1.12/
tCActionGetAttributeNames ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCAction
    -- ^ /@action@/: the t'GI.NM.Structs.TCAction.TCAction'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of attribute names,
tCActionGetAttributeNames :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCAction -> m [Text]
tCActionGetAttributeNames TCAction
action = 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 TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    Ptr CString
result <- Ptr TCAction -> IO (Ptr CString)
nm_tc_action_get_attribute_names Ptr TCAction
action'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"tCActionGetAttributeNames" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    TCAction -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCAction
action
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

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

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


#endif

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

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

#if defined(ENABLE_OVERLOADING)
data TCActionGetKindMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod TCActionGetKindMethodInfo TCAction signature where
    overloadedMethod = tCActionGetKind

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


#endif

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

-- | Increases the reference count of the object.
-- 
-- /Since: 1.12/
tCActionRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCAction
    -- ^ /@action@/: the t'GI.NM.Structs.TCAction.TCAction'
    -> m ()
tCActionRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => TCAction -> m ()
tCActionRef 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 TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    Ptr TCAction -> IO ()
nm_tc_action_ref Ptr TCAction
action'
    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 TCActionRefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TCActionRefMethodInfo TCAction signature where
    overloadedMethod = tCActionRef

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


#endif

-- method TCAction::set_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "NM" , name = "TCAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #NMTCAction" , 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 action 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_action_set_attribute" nm_tc_action_set_attribute :: 
    Ptr TCAction ->                         -- action : TInterface (Name {namespace = "NM", name = "TCAction"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- value : TVariant
    IO ()

-- | Sets or clears the named attribute on /@action@/ to the given value.
-- 
-- /Since: 1.12/
tCActionSetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCAction
    -- ^ /@action@/: the t'GI.NM.Structs.TCAction.TCAction'
    -> T.Text
    -- ^ /@name@/: the name of an action attribute
    -> Maybe (GVariant)
    -- ^ /@value@/: the value
    -> m ()
tCActionSetAttribute :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
TCAction -> Text -> Maybe GVariant -> m ()
tCActionSetAttribute TCAction
action 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 TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    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 TCAction -> CString -> Ptr GVariant -> IO ()
nm_tc_action_set_attribute Ptr TCAction
action' CString
name' Ptr GVariant
maybeValue
    TCAction -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr TCAction
action
    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 TCActionSetAttributeMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> m ()), MonadIO m) => O.OverloadedMethod TCActionSetAttributeMethodInfo TCAction signature where
    overloadedMethod = tCActionSetAttribute

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


#endif

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

-- | Decreases the reference count of the object.  If the reference count
-- reaches zero, the object will be destroyed.
-- 
-- /Since: 1.12/
tCActionUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    TCAction
    -- ^ /@action@/: the t'GI.NM.Structs.TCAction.TCAction'
    -> m ()
tCActionUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => TCAction -> m ()
tCActionUnref 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 TCAction
action' <- TCAction -> IO (Ptr TCAction)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr TCAction
action
    Ptr TCAction -> IO ()
nm_tc_action_unref Ptr TCAction
action'
    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 TCActionUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod TCActionUnrefMethodInfo TCAction signature where
    overloadedMethod = tCActionUnref

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveTCActionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTCActionMethod "dup" o = TCActionDupMethodInfo
    ResolveTCActionMethod "equal" o = TCActionEqualMethodInfo
    ResolveTCActionMethod "ref" o = TCActionRefMethodInfo
    ResolveTCActionMethod "unref" o = TCActionUnrefMethodInfo
    ResolveTCActionMethod "getAttribute" o = TCActionGetAttributeMethodInfo
    ResolveTCActionMethod "getAttributeNames" o = TCActionGetAttributeNamesMethodInfo
    ResolveTCActionMethod "getKind" o = TCActionGetKindMethodInfo
    ResolveTCActionMethod "setAttribute" o = TCActionSetAttributeMethodInfo
    ResolveTCActionMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif