{-# LANGUAGE TypeApplications #-}
#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif
module GI.NM.Structs.TCAction
(
TCAction(..) ,
#if defined(ENABLE_OVERLOADING)
ResolveTCActionMethod ,
#endif
#if defined(ENABLE_OVERLOADING)
TCActionDupMethodInfo ,
#endif
tCActionDup ,
#if defined(ENABLE_OVERLOADING)
TCActionEqualMethodInfo ,
#endif
tCActionEqual ,
#if defined(ENABLE_OVERLOADING)
TCActionGetAttributeMethodInfo ,
#endif
tCActionGetAttribute ,
#if defined(ENABLE_OVERLOADING)
TCActionGetAttributeNamesMethodInfo ,
#endif
tCActionGetAttributeNames ,
#if defined(ENABLE_OVERLOADING)
TCActionGetKindMethodInfo ,
#endif
tCActionGetKind ,
tCActionNew ,
#if defined(ENABLE_OVERLOADING)
TCActionRefMethodInfo ,
#endif
tCActionRef ,
#if defined(ENABLE_OVERLOADING)
TCActionSetAttributeMethodInfo ,
#endif
tCActionSetAttribute ,
#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
#if MIN_VERSION_base(4,18,0)
#else
#endif
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
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
foreign import ccall "nm_tc_action_new" nm_tc_action_new ::
CString ->
Ptr (Ptr GError) ->
IO (Ptr TCAction)
tCActionNew ::
(B.CallStack.HasCallStack, MonadIO m) =>
T.Text
-> m TCAction
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
foreign import ccall "nm_tc_action_dup" nm_tc_action_dup ::
Ptr TCAction ->
IO (Ptr TCAction)
tCActionDup ::
(B.CallStack.HasCallStack, MonadIO m) =>
TCAction
-> m TCAction
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
foreign import ccall "nm_tc_action_equal" nm_tc_action_equal ::
Ptr TCAction ->
Ptr TCAction ->
IO CInt
tCActionEqual ::
(B.CallStack.HasCallStack, MonadIO m) =>
TCAction
-> TCAction
-> m Bool
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
foreign import ccall "nm_tc_action_get_attribute" nm_tc_action_get_attribute ::
Ptr TCAction ->
CString ->
IO (Ptr GVariant)
tCActionGetAttribute ::
(B.CallStack.HasCallStack, MonadIO m) =>
TCAction
-> T.Text
-> m GVariant
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
foreign import ccall "nm_tc_action_get_attribute_names" nm_tc_action_get_attribute_names ::
Ptr TCAction ->
IO (Ptr CString)
tCActionGetAttributeNames ::
(B.CallStack.HasCallStack, MonadIO m) =>
TCAction
-> m [T.Text]
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
foreign import ccall "nm_tc_action_get_kind" nm_tc_action_get_kind ::
Ptr TCAction ->
IO CString
tCActionGetKind ::
(B.CallStack.HasCallStack, MonadIO m) =>
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
foreign import ccall "nm_tc_action_ref" nm_tc_action_ref ::
Ptr TCAction ->
IO ()
tCActionRef ::
(B.CallStack.HasCallStack, MonadIO m) =>
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
foreign import ccall "nm_tc_action_set_attribute" nm_tc_action_set_attribute ::
Ptr TCAction ->
CString ->
Ptr GVariant ->
IO ()
tCActionSetAttribute ::
(B.CallStack.HasCallStack, MonadIO m) =>
TCAction
-> T.Text
-> Maybe (GVariant)
-> 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
foreign import ccall "nm_tc_action_unref" nm_tc_action_unref ::
Ptr TCAction ->
IO ()
tCActionUnref ::
(B.CallStack.HasCallStack, MonadIO m) =>
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