{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Clutter.Structs.StateKey.StateKey' is an opaque structure whose
-- members cannot be accessed directly
-- 
-- /Since: 1.4/

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

module GI.Clutter.Structs.StateKey
    ( 

-- * Exported types
    StateKey(..)                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- /None/.
-- 
-- ==== Getters
-- [getMode]("GI.Clutter.Structs.StateKey#g:method:getMode"), [getObject]("GI.Clutter.Structs.StateKey#g:method:getObject"), [getPostDelay]("GI.Clutter.Structs.StateKey#g:method:getPostDelay"), [getPreDelay]("GI.Clutter.Structs.StateKey#g:method:getPreDelay"), [getPropertyName]("GI.Clutter.Structs.StateKey#g:method:getPropertyName"), [getPropertyType]("GI.Clutter.Structs.StateKey#g:method:getPropertyType"), [getSourceStateName]("GI.Clutter.Structs.StateKey#g:method:getSourceStateName"), [getTargetStateName]("GI.Clutter.Structs.StateKey#g:method:getTargetStateName"), [getValue]("GI.Clutter.Structs.StateKey#g:method:getValue").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveStateKeyMethod                   ,
#endif

-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetModeMethodInfo               ,
#endif
    stateKeyGetMode                         ,


-- ** getObject #method:getObject#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetObjectMethodInfo             ,
#endif
    stateKeyGetObject                       ,


-- ** getPostDelay #method:getPostDelay#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetPostDelayMethodInfo          ,
#endif
    stateKeyGetPostDelay                    ,


-- ** getPreDelay #method:getPreDelay#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetPreDelayMethodInfo           ,
#endif
    stateKeyGetPreDelay                     ,


-- ** getPropertyName #method:getPropertyName#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetPropertyNameMethodInfo       ,
#endif
    stateKeyGetPropertyName                 ,


-- ** getPropertyType #method:getPropertyType#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetPropertyTypeMethodInfo       ,
#endif
    stateKeyGetPropertyType                 ,


-- ** getSourceStateName #method:getSourceStateName#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetSourceStateNameMethodInfo    ,
#endif
    stateKeyGetSourceStateName              ,


-- ** getTargetStateName #method:getTargetStateName#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetTargetStateNameMethodInfo    ,
#endif
    stateKeyGetTargetStateName              ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    StateKeyGetValueMethodInfo              ,
#endif
    stateKeyGetValue                        ,




    ) where

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

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

import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_state_key_get_type" c_clutter_state_key_get_type :: 
    IO GType

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

instance B.Types.TypedObject StateKey where
    glibType :: IO GType
glibType = IO GType
c_clutter_state_key_get_type

instance B.Types.GBoxed StateKey

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


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList StateKey
type instance O.AttributeList StateKey = StateKeyAttributeList
type StateKeyAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method StateKey::get_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TULong)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_mode" clutter_state_key_get_mode :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CULong

{-# DEPRECATED stateKeyGetMode ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the easing mode used for /@stateKey@/.
-- 
-- /Since: 1.4/
stateKeyGetMode ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m CULong
    -- ^ __Returns:__ the mode of a t'GI.Clutter.Structs.StateKey.StateKey'
stateKeyGetMode :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m CULong
stateKeyGetMode StateKey
stateKey = IO CULong -> m CULong
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CULong -> m CULong) -> IO CULong -> m CULong
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    CULong
result <- Ptr StateKey -> IO CULong
clutter_state_key_get_mode Ptr StateKey
stateKey'
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    CULong -> IO CULong
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CULong
result

#if defined(ENABLE_OVERLOADING)
data StateKeyGetModeMethodInfo
instance (signature ~ (m CULong), MonadIO m) => O.OverloadedMethod StateKeyGetModeMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetMode

instance O.OverloadedMethodInfo StateKeyGetModeMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetMode",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetMode"
        })


#endif

-- method StateKey::get_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GObject" , name = "Object" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_object" clutter_state_key_get_object :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO (Ptr GObject.Object.Object)

{-# DEPRECATED stateKeyGetObject ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the object instance this t'GI.Clutter.Structs.StateKey.StateKey' applies to.
-- 
-- /Since: 1.4/
stateKeyGetObject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m GObject.Object.Object
    -- ^ __Returns:__ the object this state key applies to.
stateKeyGetObject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m Object
stateKeyGetObject StateKey
stateKey = IO Object -> m Object
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Object -> m Object) -> IO Object -> m Object
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    Ptr Object
result <- Ptr StateKey -> IO (Ptr Object)
clutter_state_key_get_object Ptr StateKey
stateKey'
    Text -> Ptr Object -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateKeyGetObject" Ptr Object
result
    Object
result' <- ((ManagedPtr Object -> Object) -> Ptr Object -> IO Object
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Object -> Object
GObject.Object.Object) Ptr Object
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    Object -> IO Object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetObjectMethodInfo
instance (signature ~ (m GObject.Object.Object), MonadIO m) => O.OverloadedMethod StateKeyGetObjectMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetObject

instance O.OverloadedMethodInfo StateKeyGetObjectMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetObject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetObject"
        })


#endif

-- method StateKey::get_post_delay
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_post_delay" clutter_state_key_get_post_delay :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CDouble

{-# DEPRECATED stateKeyGetPostDelay ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the duration of the pause after transitioning is complete
-- as a fraction of the total transition time.
-- 
-- /Since: 1.4/
stateKeyGetPostDelay ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m Double
    -- ^ __Returns:__ the post delay, used after doing the transition.
stateKeyGetPostDelay :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m Double
stateKeyGetPostDelay StateKey
stateKey = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    CDouble
result <- Ptr StateKey -> IO CDouble
clutter_state_key_get_post_delay Ptr StateKey
stateKey'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetPostDelayMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod StateKeyGetPostDelayMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetPostDelay

instance O.OverloadedMethodInfo StateKeyGetPostDelayMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetPostDelay",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetPostDelay"
        })


#endif

-- method StateKey::get_pre_delay
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TDouble)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_pre_delay" clutter_state_key_get_pre_delay :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CDouble

{-# DEPRECATED stateKeyGetPreDelay ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the pause before transitioning starts as a fraction of
-- the total transition time.
-- 
-- /Since: 1.4/
stateKeyGetPreDelay ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m Double
    -- ^ __Returns:__ the pre delay used before starting the transition.
stateKeyGetPreDelay :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m Double
stateKeyGetPreDelay StateKey
stateKey = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    CDouble
result <- Ptr StateKey -> IO CDouble
clutter_state_key_get_pre_delay Ptr StateKey
stateKey'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetPreDelayMethodInfo
instance (signature ~ (m Double), MonadIO m) => O.OverloadedMethod StateKeyGetPreDelayMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetPreDelay

instance O.OverloadedMethodInfo StateKeyGetPreDelayMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetPreDelay",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetPreDelay"
        })


#endif

-- method StateKey::get_property_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_property_name" clutter_state_key_get_property_name :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CString

{-# DEPRECATED stateKeyGetPropertyName ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the name of the property this t'GI.Clutter.Structs.StateKey.StateKey' applies to
-- 
-- /Since: 1.4/
stateKeyGetPropertyName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m T.Text
    -- ^ __Returns:__ the name of the property. The returned string is owned
    --   by the t'GI.Clutter.Structs.StateKey.StateKey' and should never be modified or freed
stateKeyGetPropertyName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m Text
stateKeyGetPropertyName StateKey
stateKey = 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 StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    CString
result <- Ptr StateKey -> IO CString
clutter_state_key_get_property_name Ptr StateKey
stateKey'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateKeyGetPropertyName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetPropertyNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod StateKeyGetPropertyNameMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetPropertyName

instance O.OverloadedMethodInfo StateKeyGetPropertyNameMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetPropertyName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetPropertyName"
        })


#endif

-- method StateKey::get_property_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_property_type" clutter_state_key_get_property_type :: 
    Ptr StateKey ->                         -- key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CGType

{-# DEPRECATED stateKeyGetPropertyType ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the t'GType' of the property a key applies to
-- 
-- You can use this type to initialize the t'GI.GObject.Structs.Value.Value' to pass to
-- 'GI.Clutter.Structs.StateKey.stateKeyGetValue'
-- 
-- /Since: 1.4/
stateKeyGetPropertyType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@key@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m GType
    -- ^ __Returns:__ the t'GType' of the property
stateKeyGetPropertyType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m GType
stateKeyGetPropertyType StateKey
key = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ do
    Ptr StateKey
key' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
key
    CGType
result <- Ptr StateKey -> IO CGType
clutter_state_key_get_property_type Ptr StateKey
key'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
key
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetPropertyTypeMethodInfo
instance (signature ~ (m GType), MonadIO m) => O.OverloadedMethod StateKeyGetPropertyTypeMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetPropertyType

instance O.OverloadedMethodInfo StateKeyGetPropertyTypeMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetPropertyType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetPropertyType"
        })


#endif

-- method StateKey::get_source_state_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_source_state_name" clutter_state_key_get_source_state_name :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CString

{-# DEPRECATED stateKeyGetSourceStateName ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves the name of the source state of the /@stateKey@/
-- 
-- /Since: 1.4/
stateKeyGetSourceStateName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m T.Text
    -- ^ __Returns:__ the name of the source state for this key, or 'P.Nothing'
    --   if this is the generic state key for the given property when
    --   transitioning to the target state. The returned string is owned
    --   by the t'GI.Clutter.Structs.StateKey.StateKey' and should never be modified or freed
stateKeyGetSourceStateName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m Text
stateKeyGetSourceStateName StateKey
stateKey = 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 StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    CString
result <- Ptr StateKey -> IO CString
clutter_state_key_get_source_state_name Ptr StateKey
stateKey'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateKeyGetSourceStateName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetSourceStateNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod StateKeyGetSourceStateNameMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetSourceStateName

instance O.OverloadedMethodInfo StateKeyGetSourceStateNameMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetSourceStateName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetSourceStateName"
        })


#endif

-- method StateKey::get_target_state_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_target_state_name" clutter_state_key_get_target_state_name :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    IO CString

{-# DEPRECATED stateKeyGetTargetStateName ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Get the name of the source state this t'GI.Clutter.Structs.StateKey.StateKey' contains,
-- or NULL if this is the generic state key for the given property
-- when transitioning to the target state.
-- 
-- /Since: 1.4/
stateKeyGetTargetStateName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> m T.Text
    -- ^ __Returns:__ the name of the source state for this key, or NULL if
    --   the key is generic
stateKeyGetTargetStateName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> m Text
stateKeyGetTargetStateName StateKey
stateKey = 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 StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    CString
result <- Ptr StateKey -> IO CString
clutter_state_key_get_target_state_name Ptr StateKey
stateKey'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"stateKeyGetTargetStateName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetTargetStateNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod StateKeyGetTargetStateNameMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetTargetStateName

instance O.OverloadedMethodInfo StateKeyGetTargetStateNameMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetTargetStateName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetTargetStateName"
        })


#endif

-- method StateKey::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "state_key"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "StateKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterStateKey" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GValue initialized with the correct type for the @state_key"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_state_key_get_value" clutter_state_key_get_value :: 
    Ptr StateKey ->                         -- state_key : TInterface (Name {namespace = "Clutter", name = "StateKey"})
    Ptr GValue ->                           -- value : TGValue
    IO CInt

{-# DEPRECATED stateKeyGetValue ["(Since version 1.12)","Use t'GI.Clutter.Objects.KeyframeTransition.KeyframeTransition' and","  t'GI.Clutter.Objects.TransitionGroup.TransitionGroup' instead"] #-}
-- | Retrieves a copy of the value for a t'GI.Clutter.Structs.StateKey.StateKey'.
-- 
-- The t'GI.GObject.Structs.Value.Value' needs to be already initialized for the value type
-- of the property or to a type that allow transformation from the value
-- type of the key.
-- 
-- Use 'GI.GObject.Structs.Value.valueUnset' when done.
-- 
-- /Since: 1.4/
stateKeyGetValue ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StateKey
    -- ^ /@stateKey@/: a t'GI.Clutter.Structs.StateKey.StateKey'
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' initialized with the correct type for the /@stateKey@/
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the value was successfully retrieved,
    --   and 'P.False' otherwise
stateKeyGetValue :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
StateKey -> GValue -> m Bool
stateKeyGetValue StateKey
stateKey GValue
value = 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 StateKey
stateKey' <- StateKey -> IO (Ptr StateKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr StateKey
stateKey
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr StateKey -> Ptr GValue -> IO CInt
clutter_state_key_get_value Ptr StateKey
stateKey' Ptr GValue
value'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    StateKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr StateKey
stateKey
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StateKeyGetValueMethodInfo
instance (signature ~ (GValue -> m Bool), MonadIO m) => O.OverloadedMethod StateKeyGetValueMethodInfo StateKey signature where
    overloadedMethod = stateKeyGetValue

instance O.OverloadedMethodInfo StateKeyGetValueMethodInfo StateKey where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Structs.StateKey.stateKeyGetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Structs-StateKey.html#v:stateKeyGetValue"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveStateKeyMethod (t :: Symbol) (o :: *) :: * where
    ResolveStateKeyMethod "getMode" o = StateKeyGetModeMethodInfo
    ResolveStateKeyMethod "getObject" o = StateKeyGetObjectMethodInfo
    ResolveStateKeyMethod "getPostDelay" o = StateKeyGetPostDelayMethodInfo
    ResolveStateKeyMethod "getPreDelay" o = StateKeyGetPreDelayMethodInfo
    ResolveStateKeyMethod "getPropertyName" o = StateKeyGetPropertyNameMethodInfo
    ResolveStateKeyMethod "getPropertyType" o = StateKeyGetPropertyTypeMethodInfo
    ResolveStateKeyMethod "getSourceStateName" o = StateKeyGetSourceStateNameMethodInfo
    ResolveStateKeyMethod "getTargetStateName" o = StateKeyGetTargetStateNameMethodInfo
    ResolveStateKeyMethod "getValue" o = StateKeyGetValueMethodInfo
    ResolveStateKeyMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif