{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Clutter.Objects.Interval.Interval' structure contains only private data and should
-- be accessed using the provided functions.
-- 
-- /Since: 1.0/

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

module GI.Clutter.Objects.Interval
    ( 

-- * Exported types
    Interval(..)                            ,
    IsInterval                              ,
    toInterval                              ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clone]("GI.Clutter.Objects.Interval#g:method:clone"), [compute]("GI.Clutter.Objects.Interval#g:method:compute"), [computeValue]("GI.Clutter.Objects.Interval#g:method:computeValue"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isValid]("GI.Clutter.Objects.Interval#g:method:isValid"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [parseCustomNode]("GI.Clutter.Interfaces.Scriptable#g:method:parseCustomNode"), [peekFinalValue]("GI.Clutter.Objects.Interval#g:method:peekFinalValue"), [peekInitialValue]("GI.Clutter.Objects.Interval#g:method:peekInitialValue"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [validate]("GI.Clutter.Objects.Interval#g:method:validate"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFinalValue]("GI.Clutter.Objects.Interval#g:method:getFinalValue"), [getId]("GI.Clutter.Interfaces.Scriptable#g:method:getId"), [getInitialValue]("GI.Clutter.Objects.Interval#g:method:getInitialValue"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getValueType]("GI.Clutter.Objects.Interval#g:method:getValueType").
-- 
-- ==== Setters
-- [setCustomProperty]("GI.Clutter.Interfaces.Scriptable#g:method:setCustomProperty"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFinal]("GI.Clutter.Objects.Interval#g:method:setFinal"), [setId]("GI.Clutter.Interfaces.Scriptable#g:method:setId"), [setInitial]("GI.Clutter.Objects.Interval#g:method:setInitial"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveIntervalMethod                   ,
#endif

-- ** clone #method:clone#

#if defined(ENABLE_OVERLOADING)
    IntervalCloneMethodInfo                 ,
#endif
    intervalClone                           ,


-- ** compute #method:compute#

#if defined(ENABLE_OVERLOADING)
    IntervalComputeMethodInfo               ,
#endif
    intervalCompute                         ,


-- ** computeValue #method:computeValue#

#if defined(ENABLE_OVERLOADING)
    IntervalComputeValueMethodInfo          ,
#endif
    intervalComputeValue                    ,


-- ** getFinalValue #method:getFinalValue#

#if defined(ENABLE_OVERLOADING)
    IntervalGetFinalValueMethodInfo         ,
#endif
    intervalGetFinalValue                   ,


-- ** getInitialValue #method:getInitialValue#

#if defined(ENABLE_OVERLOADING)
    IntervalGetInitialValueMethodInfo       ,
#endif
    intervalGetInitialValue                 ,


-- ** getValueType #method:getValueType#

#if defined(ENABLE_OVERLOADING)
    IntervalGetValueTypeMethodInfo          ,
#endif
    intervalGetValueType                    ,


-- ** isValid #method:isValid#

#if defined(ENABLE_OVERLOADING)
    IntervalIsValidMethodInfo               ,
#endif
    intervalIsValid                         ,


-- ** newWithValues #method:newWithValues#

    intervalNewWithValues                   ,


-- ** peekFinalValue #method:peekFinalValue#

#if defined(ENABLE_OVERLOADING)
    IntervalPeekFinalValueMethodInfo        ,
#endif
    intervalPeekFinalValue                  ,


-- ** peekInitialValue #method:peekInitialValue#

#if defined(ENABLE_OVERLOADING)
    IntervalPeekInitialValueMethodInfo      ,
#endif
    intervalPeekInitialValue                ,


-- ** setFinal #method:setFinal#

#if defined(ENABLE_OVERLOADING)
    IntervalSetFinalMethodInfo              ,
#endif
    intervalSetFinal                        ,


-- ** setInitial #method:setInitial#

#if defined(ENABLE_OVERLOADING)
    IntervalSetInitialMethodInfo            ,
#endif
    intervalSetInitial                      ,


-- ** validate #method:validate#

#if defined(ENABLE_OVERLOADING)
    IntervalValidateMethodInfo              ,
#endif
    intervalValidate                        ,




 -- * Properties


-- ** final #attr:final#
-- | The final value of the interval.
-- 
-- /Since: 1.12/

#if defined(ENABLE_OVERLOADING)
    IntervalFinalPropertyInfo               ,
#endif
    constructIntervalFinal                  ,
    getIntervalFinal                        ,
#if defined(ENABLE_OVERLOADING)
    intervalFinal                           ,
#endif
    setIntervalFinal                        ,


-- ** initial #attr:initial#
-- | The initial value of the interval.
-- 
-- /Since: 1.12/

#if defined(ENABLE_OVERLOADING)
    IntervalInitialPropertyInfo             ,
#endif
    constructIntervalInitial                ,
    getIntervalInitial                      ,
#if defined(ENABLE_OVERLOADING)
    intervalInitial                         ,
#endif
    setIntervalInitial                      ,


-- ** valueType #attr:valueType#
-- | The type of the values in the interval.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    IntervalValueTypePropertyInfo           ,
#endif
    constructIntervalValueType              ,
    getIntervalValueType                    ,
#if defined(ENABLE_OVERLOADING)
    intervalValueType                       ,
#endif




    ) 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 {-# SOURCE #-} qualified GI.Clutter.Interfaces.Scriptable as Clutter.Scriptable
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "clutter_interval_get_type"
    c_clutter_interval_get_type :: IO B.Types.GType

instance B.Types.TypedObject Interval where
    glibType :: IO GType
glibType = IO GType
c_clutter_interval_get_type

instance B.Types.GObject Interval

-- | Type class for types which can be safely cast to `Interval`, for instance with `toInterval`.
class (SP.GObject o, O.IsDescendantOf Interval o) => IsInterval o
instance (SP.GObject o, O.IsDescendantOf Interval o) => IsInterval o

instance O.HasParentTypes Interval
type instance O.ParentTypes Interval = '[GObject.Object.Object, Clutter.Scriptable.Scriptable]

-- | Cast to `Interval`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toInterval :: (MIO.MonadIO m, IsInterval o) => o -> m Interval
toInterval :: forall (m :: * -> *) o.
(MonadIO m, IsInterval o) =>
o -> m Interval
toInterval = IO Interval -> m Interval
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Interval -> m Interval)
-> (o -> IO Interval) -> o -> m Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Interval -> Interval) -> o -> IO Interval
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Interval -> Interval
Interval

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

#if defined(ENABLE_OVERLOADING)
type family ResolveIntervalMethod (t :: Symbol) (o :: *) :: * where
    ResolveIntervalMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveIntervalMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveIntervalMethod "clone" o = IntervalCloneMethodInfo
    ResolveIntervalMethod "compute" o = IntervalComputeMethodInfo
    ResolveIntervalMethod "computeValue" o = IntervalComputeValueMethodInfo
    ResolveIntervalMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveIntervalMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveIntervalMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveIntervalMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveIntervalMethod "isValid" o = IntervalIsValidMethodInfo
    ResolveIntervalMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveIntervalMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveIntervalMethod "parseCustomNode" o = Clutter.Scriptable.ScriptableParseCustomNodeMethodInfo
    ResolveIntervalMethod "peekFinalValue" o = IntervalPeekFinalValueMethodInfo
    ResolveIntervalMethod "peekInitialValue" o = IntervalPeekInitialValueMethodInfo
    ResolveIntervalMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveIntervalMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveIntervalMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveIntervalMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveIntervalMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveIntervalMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveIntervalMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveIntervalMethod "validate" o = IntervalValidateMethodInfo
    ResolveIntervalMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveIntervalMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveIntervalMethod "getFinalValue" o = IntervalGetFinalValueMethodInfo
    ResolveIntervalMethod "getId" o = Clutter.Scriptable.ScriptableGetIdMethodInfo
    ResolveIntervalMethod "getInitialValue" o = IntervalGetInitialValueMethodInfo
    ResolveIntervalMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveIntervalMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveIntervalMethod "getValueType" o = IntervalGetValueTypeMethodInfo
    ResolveIntervalMethod "setCustomProperty" o = Clutter.Scriptable.ScriptableSetCustomPropertyMethodInfo
    ResolveIntervalMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveIntervalMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveIntervalMethod "setFinal" o = IntervalSetFinalMethodInfo
    ResolveIntervalMethod "setId" o = Clutter.Scriptable.ScriptableSetIdMethodInfo
    ResolveIntervalMethod "setInitial" o = IntervalSetInitialMethodInfo
    ResolveIntervalMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveIntervalMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "final"
   -- Type: TGValue
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@final@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' interval #final
-- @
getIntervalFinal :: (MonadIO m, IsInterval o) => o -> m (Maybe GValue)
getIntervalFinal :: forall (m :: * -> *) o.
(MonadIO m, IsInterval o) =>
o -> m (Maybe GValue)
getIntervalFinal o
obj = IO (Maybe GValue) -> m (Maybe GValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe GValue)
forall a. GObject a => a -> String -> IO (Maybe GValue)
B.Properties.getObjectPropertyGValue o
obj String
"final"

-- | Set the value of the “@final@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' interval [ #final 'Data.GI.Base.Attributes.:=' value ]
-- @
setIntervalFinal :: (MonadIO m, IsInterval o) => o -> GValue -> m ()
setIntervalFinal :: forall (m :: * -> *) o.
(MonadIO m, IsInterval o) =>
o -> GValue -> m ()
setIntervalFinal o
obj GValue
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe GValue -> IO ()
forall a. GObject a => a -> String -> Maybe GValue -> IO ()
B.Properties.setObjectPropertyGValue o
obj String
"final" (GValue -> Maybe GValue
forall a. a -> Maybe a
Just GValue
val)

-- | Construct a `GValueConstruct` with valid value for the “@final@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIntervalFinal :: (IsInterval o, MIO.MonadIO m) => GValue -> m (GValueConstruct o)
constructIntervalFinal :: forall o (m :: * -> *).
(IsInterval o, MonadIO m) =>
GValue -> m (GValueConstruct o)
constructIntervalFinal GValue
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe GValue -> IO (GValueConstruct o)
forall o. String -> Maybe GValue -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGValue String
"final" (GValue -> Maybe GValue
forall a. a -> Maybe a
P.Just GValue
val)

#if defined(ENABLE_OVERLOADING)
data IntervalFinalPropertyInfo
instance AttrInfo IntervalFinalPropertyInfo where
    type AttrAllowedOps IntervalFinalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint IntervalFinalPropertyInfo = IsInterval
    type AttrSetTypeConstraint IntervalFinalPropertyInfo = (~) GValue
    type AttrTransferTypeConstraint IntervalFinalPropertyInfo = (~) GValue
    type AttrTransferType IntervalFinalPropertyInfo = GValue
    type AttrGetType IntervalFinalPropertyInfo = (Maybe GValue)
    type AttrLabel IntervalFinalPropertyInfo = "final"
    type AttrOrigin IntervalFinalPropertyInfo = Interval
    attrGet = getIntervalFinal
    attrSet = setIntervalFinal
    attrTransfer _ v = do
        return v
    attrConstruct = constructIntervalFinal
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.final"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#g:attr:final"
        })
#endif

-- VVV Prop "initial"
   -- Type: TGValue
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Just False)

-- | Get the value of the “@initial@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' interval #initial
-- @
getIntervalInitial :: (MonadIO m, IsInterval o) => o -> m (Maybe GValue)
getIntervalInitial :: forall (m :: * -> *) o.
(MonadIO m, IsInterval o) =>
o -> m (Maybe GValue)
getIntervalInitial o
obj = IO (Maybe GValue) -> m (Maybe GValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe GValue) -> m (Maybe GValue))
-> IO (Maybe GValue) -> m (Maybe GValue)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe GValue)
forall a. GObject a => a -> String -> IO (Maybe GValue)
B.Properties.getObjectPropertyGValue o
obj String
"initial"

-- | Set the value of the “@initial@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' interval [ #initial 'Data.GI.Base.Attributes.:=' value ]
-- @
setIntervalInitial :: (MonadIO m, IsInterval o) => o -> GValue -> m ()
setIntervalInitial :: forall (m :: * -> *) o.
(MonadIO m, IsInterval o) =>
o -> GValue -> m ()
setIntervalInitial o
obj GValue
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe GValue -> IO ()
forall a. GObject a => a -> String -> Maybe GValue -> IO ()
B.Properties.setObjectPropertyGValue o
obj String
"initial" (GValue -> Maybe GValue
forall a. a -> Maybe a
Just GValue
val)

-- | Construct a `GValueConstruct` with valid value for the “@initial@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIntervalInitial :: (IsInterval o, MIO.MonadIO m) => GValue -> m (GValueConstruct o)
constructIntervalInitial :: forall o (m :: * -> *).
(IsInterval o, MonadIO m) =>
GValue -> m (GValueConstruct o)
constructIntervalInitial GValue
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe GValue -> IO (GValueConstruct o)
forall o. String -> Maybe GValue -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGValue String
"initial" (GValue -> Maybe GValue
forall a. a -> Maybe a
P.Just GValue
val)

#if defined(ENABLE_OVERLOADING)
data IntervalInitialPropertyInfo
instance AttrInfo IntervalInitialPropertyInfo where
    type AttrAllowedOps IntervalInitialPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint IntervalInitialPropertyInfo = IsInterval
    type AttrSetTypeConstraint IntervalInitialPropertyInfo = (~) GValue
    type AttrTransferTypeConstraint IntervalInitialPropertyInfo = (~) GValue
    type AttrTransferType IntervalInitialPropertyInfo = GValue
    type AttrGetType IntervalInitialPropertyInfo = (Maybe GValue)
    type AttrLabel IntervalInitialPropertyInfo = "initial"
    type AttrOrigin IntervalInitialPropertyInfo = Interval
    attrGet = getIntervalInitial
    attrSet = setIntervalInitial
    attrTransfer _ v = do
        return v
    attrConstruct = constructIntervalInitial
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.initial"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#g:attr:initial"
        })
#endif

-- VVV Prop "value-type"
   -- Type: TBasicType TGType
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@value-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' interval #valueType
-- @
getIntervalValueType :: (MonadIO m, IsInterval o) => o -> m GType
getIntervalValueType :: forall (m :: * -> *) o. (MonadIO m, IsInterval o) => o -> m GType
getIntervalValueType o
obj = IO GType -> m GType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO GType -> m GType) -> IO GType -> m GType
forall a b. (a -> b) -> a -> b
$ o -> String -> IO GType
forall a. GObject a => a -> String -> IO GType
B.Properties.getObjectPropertyGType o
obj String
"value-type"

-- | Construct a `GValueConstruct` with valid value for the “@value-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructIntervalValueType :: (IsInterval o, MIO.MonadIO m) => GType -> m (GValueConstruct o)
constructIntervalValueType :: forall o (m :: * -> *).
(IsInterval o, MonadIO m) =>
GType -> m (GValueConstruct o)
constructIntervalValueType GType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> GType -> IO (GValueConstruct o)
forall o. String -> GType -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyGType String
"value-type" GType
val

#if defined(ENABLE_OVERLOADING)
data IntervalValueTypePropertyInfo
instance AttrInfo IntervalValueTypePropertyInfo where
    type AttrAllowedOps IntervalValueTypePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint IntervalValueTypePropertyInfo = IsInterval
    type AttrSetTypeConstraint IntervalValueTypePropertyInfo = (~) GType
    type AttrTransferTypeConstraint IntervalValueTypePropertyInfo = (~) GType
    type AttrTransferType IntervalValueTypePropertyInfo = GType
    type AttrGetType IntervalValueTypePropertyInfo = GType
    type AttrLabel IntervalValueTypePropertyInfo = "value-type"
    type AttrOrigin IntervalValueTypePropertyInfo = Interval
    attrGet = getIntervalValueType
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructIntervalValueType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.valueType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#g:attr:valueType"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Interval
type instance O.AttributeList Interval = IntervalAttributeList
type IntervalAttributeList = ('[ '("final", IntervalFinalPropertyInfo), '("initial", IntervalInitialPropertyInfo), '("valueType", IntervalValueTypePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
intervalFinal :: AttrLabelProxy "final"
intervalFinal = AttrLabelProxy

intervalInitial :: AttrLabelProxy "initial"
intervalInitial = AttrLabelProxy

intervalValueType :: AttrLabelProxy "valueType"
intervalValueType = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Interval = IntervalSignalList
type IntervalSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Interval::new_with_values
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "gtype"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the type of the values in the interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "initial"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue holding the initial value of the interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "final"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue holding the final value of the interval"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Clutter" , name = "Interval" })
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_new_with_values" clutter_interval_new_with_values :: 
    CGType ->                               -- gtype : TBasicType TGType
    Ptr GValue ->                           -- initial : TGValue
    Ptr GValue ->                           -- final : TGValue
    IO (Ptr Interval)

-- | Creates a new t'GI.Clutter.Objects.Interval.Interval' of type /@gtype@/, between /@initial@/
-- and /@final@/.
-- 
-- This function is useful for language bindings.
-- 
-- /Since: 1.0/
intervalNewWithValues ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    -- ^ /@gtype@/: the type of the values in the interval
    -> Maybe (GValue)
    -- ^ /@initial@/: a t'GI.GObject.Structs.Value.Value' holding the initial value of the interval
    -> Maybe (GValue)
    -- ^ /@final@/: a t'GI.GObject.Structs.Value.Value' holding the final value of the interval
    -> m Interval
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Interval.Interval'
intervalNewWithValues :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
GType -> Maybe GValue -> Maybe GValue -> m Interval
intervalNewWithValues GType
gtype Maybe GValue
initial Maybe GValue
final = IO Interval -> m Interval
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Interval -> m Interval) -> IO Interval -> m Interval
forall a b. (a -> b) -> a -> b
$ do
    let gtype' :: CGType
gtype' = GType -> CGType
gtypeToCGType GType
gtype
    Ptr GValue
maybeInitial <- case Maybe GValue
initial of
        Maybe GValue
Nothing -> Ptr GValue -> IO (Ptr GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
forall a. Ptr a
nullPtr
        Just GValue
jInitial -> do
            Ptr GValue
jInitial' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
jInitial
            Ptr GValue -> IO (Ptr GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
jInitial'
    Ptr GValue
maybeFinal <- case Maybe GValue
final of
        Maybe GValue
Nothing -> Ptr GValue -> IO (Ptr GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
forall a. Ptr a
nullPtr
        Just GValue
jFinal -> do
            Ptr GValue
jFinal' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
jFinal
            Ptr GValue -> IO (Ptr GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GValue
jFinal'
    Ptr Interval
result <- CGType -> Ptr GValue -> Ptr GValue -> IO (Ptr Interval)
clutter_interval_new_with_values CGType
gtype' Ptr GValue
maybeInitial Ptr GValue
maybeFinal
    Text -> Ptr Interval -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"intervalNewWithValues" Ptr Interval
result
    Interval
result' <- ((ManagedPtr Interval -> Interval) -> Ptr Interval -> IO Interval
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Interval -> Interval
Interval) Ptr Interval
result
    Maybe GValue -> (GValue -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GValue
initial GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe GValue -> (GValue -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GValue
final GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Interval -> IO Interval
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interval
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "clutter_interval_clone" clutter_interval_clone :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO (Ptr Interval)

-- | Creates a copy of /@interval@/.
-- 
-- /Since: 1.0/
intervalClone ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m Interval
    -- ^ __Returns:__ the newly created t'GI.Clutter.Objects.Interval.Interval'
intervalClone :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m Interval
intervalClone a
interval = IO Interval -> m Interval
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Interval -> m Interval) -> IO Interval -> m Interval
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr Interval
result <- Ptr Interval -> IO (Ptr Interval)
clutter_interval_clone Ptr Interval
interval'
    Text -> Ptr Interval -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"intervalClone" Ptr Interval
result
    Interval
result' <- ((ManagedPtr Interval -> Interval) -> Ptr Interval -> IO Interval
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Interval -> Interval
Interval) Ptr Interval
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    Interval -> IO Interval
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Interval
result'

#if defined(ENABLE_OVERLOADING)
data IntervalCloneMethodInfo
instance (signature ~ (m Interval), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalCloneMethodInfo a signature where
    overloadedMethod = intervalClone

instance O.OverloadedMethodInfo IntervalCloneMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalClone",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalClone"
        })


#endif

-- method Interval::compute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the progress factor, between 0 and 1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_compute" clutter_interval_compute :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    CDouble ->                              -- factor : TBasicType TDouble
    IO (Ptr GValue)

-- | Computes the value between the /@interval@/ boundaries given the
-- progress /@factor@/
-- 
-- Unlike 'GI.Clutter.Objects.Interval.intervalComputeValue', this function will
-- return a const pointer to the computed value
-- 
-- You should use this function if you immediately pass the computed
-- value to another function that makes a copy of it, like
-- 'GI.GObject.Objects.Object.objectSetProperty'
-- 
-- /Since: 1.4/
intervalCompute ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> Double
    -- ^ /@factor@/: the progress factor, between 0 and 1
    -> m GValue
    -- ^ __Returns:__ a pointer to the computed value,
    --   or 'P.Nothing' if the computation was not successfull
intervalCompute :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> Double -> m GValue
intervalCompute a
interval Double
factor = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    let factor' :: CDouble
factor' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
factor
    Ptr GValue
result <- Ptr Interval -> CDouble -> IO (Ptr GValue)
clutter_interval_compute Ptr Interval
interval' CDouble
factor'
    Text -> Ptr GValue -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"intervalCompute" Ptr GValue
result
    GValue
result' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result'

#if defined(ENABLE_OVERLOADING)
data IntervalComputeMethodInfo
instance (signature ~ (Double -> m GValue), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalComputeMethodInfo a signature where
    overloadedMethod = intervalCompute

instance O.OverloadedMethodInfo IntervalComputeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalCompute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalCompute"
        })


#endif

-- method Interval::compute_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "factor"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the progress factor, between 0 and 1"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for an initialized #GValue"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_compute_value" clutter_interval_compute_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    CDouble ->                              -- factor : TBasicType TDouble
    Ptr GValue ->                           -- value : TGValue
    IO CInt

-- | Computes the value between the /@interval@/ boundaries given the
-- progress /@factor@/ and copies it into /@value@/.
-- 
-- /Since: 1.0/
intervalComputeValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> Double
    -- ^ /@factor@/: the progress factor, between 0 and 1
    -> m ((Bool, GValue))
    -- ^ __Returns:__ 'P.True' if the operation was successful
intervalComputeValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> Double -> m (Bool, GValue)
intervalComputeValue a
interval Double
factor = IO (Bool, GValue) -> m (Bool, GValue)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, GValue) -> m (Bool, GValue))
-> IO (Bool, GValue) -> m (Bool, GValue)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    let factor' :: CDouble
factor' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
factor
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    CInt
result <- Ptr Interval -> CDouble -> Ptr GValue -> IO CInt
clutter_interval_compute_value Ptr Interval
interval' CDouble
factor' Ptr GValue
value
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    (Bool, GValue) -> IO (Bool, GValue)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', GValue
value')

#if defined(ENABLE_OVERLOADING)
data IntervalComputeValueMethodInfo
instance (signature ~ (Double -> m ((Bool, GValue))), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalComputeValueMethodInfo a signature where
    overloadedMethod = intervalComputeValue

instance O.OverloadedMethodInfo IntervalComputeValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalComputeValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalComputeValue"
        })


#endif

-- method Interval::get_final_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_get_final_value" clutter_interval_get_final_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Retrieves the final value of /@interval@/ and copies
-- it into /@value@/.
-- 
-- The passed t'GI.GObject.Structs.Value.Value' must be initialized to the value held by
-- the t'GI.Clutter.Objects.Interval.Interval'.
-- 
-- /Since: 1.0/
intervalGetFinalValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m (GValue)
intervalGetFinalValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m GValue
intervalGetFinalValue a
interval = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Interval -> Ptr GValue -> IO ()
clutter_interval_get_final_value Ptr Interval
interval' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data IntervalGetFinalValueMethodInfo
instance (signature ~ (m (GValue)), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalGetFinalValueMethodInfo a signature where
    overloadedMethod = intervalGetFinalValue

instance O.OverloadedMethodInfo IntervalGetFinalValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalGetFinalValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalGetFinalValue"
        })


#endif

-- method Interval::get_initial_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GValue" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_get_initial_value" clutter_interval_get_initial_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Retrieves the initial value of /@interval@/ and copies
-- it into /@value@/.
-- 
-- The passed t'GI.GObject.Structs.Value.Value' must be initialized to the value held by
-- the t'GI.Clutter.Objects.Interval.Interval'.
-- 
-- /Since: 1.0/
intervalGetInitialValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m (GValue)
intervalGetInitialValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m GValue
intervalGetInitialValue a
interval = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Interval -> Ptr GValue -> IO ()
clutter_interval_get_initial_value Ptr Interval
interval' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data IntervalGetInitialValueMethodInfo
instance (signature ~ (m (GValue)), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalGetInitialValueMethodInfo a signature where
    overloadedMethod = intervalGetInitialValue

instance O.OverloadedMethodInfo IntervalGetInitialValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalGetInitialValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalGetInitialValue"
        })


#endif

-- method Interval::get_value_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , 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_interval_get_value_type" clutter_interval_get_value_type :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO CGType

-- | Retrieves the t'GType' of the values inside /@interval@/.
-- 
-- /Since: 1.0/
intervalGetValueType ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m GType
    -- ^ __Returns:__ the type of the value, or G_TYPE_INVALID
intervalGetValueType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m GType
intervalGetValueType a
interval = 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 Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    CGType
result <- Ptr Interval -> IO CGType
clutter_interval_get_value_type Ptr Interval
interval'
    let result' :: GType
result' = CGType -> GType
GType CGType
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GType -> IO GType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GType
result'

#if defined(ENABLE_OVERLOADING)
data IntervalGetValueTypeMethodInfo
instance (signature ~ (m GType), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalGetValueTypeMethodInfo a signature where
    overloadedMethod = intervalGetValueType

instance O.OverloadedMethodInfo IntervalGetValueTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalGetValueType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalGetValueType"
        })


#endif

-- method Interval::is_valid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , 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_interval_is_valid" clutter_interval_is_valid :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO CInt

-- | Checks if the /@interval@/ has a valid initial and final values.
-- 
-- /Since: 1.12/
intervalIsValid ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the t'GI.Clutter.Objects.Interval.Interval' has an initial and
    --   final values, and 'P.False' otherwise
intervalIsValid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m Bool
intervalIsValid a
interval = 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 Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    CInt
result <- Ptr Interval -> IO CInt
clutter_interval_is_valid Ptr Interval
interval'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IntervalIsValidMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalIsValidMethodInfo a signature where
    overloadedMethod = intervalIsValid

instance O.OverloadedMethodInfo IntervalIsValidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalIsValid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalIsValid"
        })


#endif

-- method Interval::peek_final_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_peek_final_value" clutter_interval_peek_final_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO (Ptr GValue)

-- | Gets the pointer to the final value of /@interval@/
-- 
-- /Since: 1.0/
intervalPeekFinalValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m GValue
    -- ^ __Returns:__ the final value of the interval.
    --   The value is owned by the t'GI.Clutter.Objects.Interval.Interval' and it should not be
    --   modified or freed
intervalPeekFinalValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m GValue
intervalPeekFinalValue a
interval = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GValue
result <- Ptr Interval -> IO (Ptr GValue)
clutter_interval_peek_final_value Ptr Interval
interval'
    Text -> Ptr GValue -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"intervalPeekFinalValue" Ptr GValue
result
    GValue
result' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result'

#if defined(ENABLE_OVERLOADING)
data IntervalPeekFinalValueMethodInfo
instance (signature ~ (m GValue), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalPeekFinalValueMethodInfo a signature where
    overloadedMethod = intervalPeekFinalValue

instance O.OverloadedMethodInfo IntervalPeekFinalValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalPeekFinalValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalPeekFinalValue"
        })


#endif

-- method Interval::peek_initial_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TGValue
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_peek_initial_value" clutter_interval_peek_initial_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    IO (Ptr GValue)

-- | Gets the pointer to the initial value of /@interval@/
-- 
-- /Since: 1.0/
intervalPeekInitialValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> m GValue
    -- ^ __Returns:__ the initial value of the interval.
    --   The value is owned by the t'GI.Clutter.Objects.Interval.Interval' and it should not be
    --   modified or freed
intervalPeekInitialValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> m GValue
intervalPeekInitialValue a
interval = IO GValue -> m GValue
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GValue
result <- Ptr Interval -> IO (Ptr GValue)
clutter_interval_peek_initial_value Ptr Interval
interval'
    Text -> Ptr GValue -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"intervalPeekInitialValue" Ptr GValue
result
    GValue
result' <- Ptr GValue -> IO GValue
B.GValue.newGValueFromPtr Ptr GValue
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO GValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
result'

#if defined(ENABLE_OVERLOADING)
data IntervalPeekInitialValueMethodInfo
instance (signature ~ (m GValue), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalPeekInitialValueMethodInfo a signature where
    overloadedMethod = intervalPeekInitialValue

instance O.OverloadedMethodInfo IntervalPeekInitialValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalPeekInitialValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalPeekInitialValue"
        })


#endif

-- method Interval::set_final
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_set_final_value" clutter_interval_set_final_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the final value of /@interval@/ to /@value@/. The value is
-- copied inside the t'GI.Clutter.Objects.Interval.Interval'.
-- 
-- /Since: 1.0/
intervalSetFinal ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> m ()
intervalSetFinal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> GValue -> m ()
intervalSetFinal a
interval GValue
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 Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Interval -> Ptr GValue -> IO ()
clutter_interval_set_final_value Ptr Interval
interval' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IntervalSetFinalMethodInfo
instance (signature ~ (GValue -> m ()), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalSetFinalMethodInfo a signature where
    overloadedMethod = intervalSetFinal

instance O.OverloadedMethodInfo IntervalSetFinalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalSetFinal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalSetFinal"
        })


#endif

-- method Interval::set_initial
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "clutter_interval_set_initial_value" clutter_interval_set_initial_value :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

-- | Sets the initial value of /@interval@/ to /@value@/. The value is copied
-- inside the t'GI.Clutter.Objects.Interval.Interval'.
-- 
-- /Since: 1.0/
intervalSetInitial ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value'
    -> m ()
intervalSetInitial :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> GValue -> m ()
intervalSetInitial a
interval GValue
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 Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    Ptr Interval -> Ptr GValue -> IO ()
clutter_interval_set_initial_value Ptr Interval
interval' Ptr GValue
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data IntervalSetInitialMethodInfo
instance (signature ~ (GValue -> m ()), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalSetInitialMethodInfo a signature where
    overloadedMethod = intervalSetInitial

instance O.OverloadedMethodInfo IntervalSetInitialMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalSetInitial",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalSetInitial"
        })


#endif

-- method Interval::validate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "interval"
--           , argType =
--               TInterface Name { namespace = "Clutter" , name = "Interval" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #ClutterInterval" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "pspec"
--           , argType = TParamSpec
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GParamSpec" , 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_interval_validate" clutter_interval_validate :: 
    Ptr Interval ->                         -- interval : TInterface (Name {namespace = "Clutter", name = "Interval"})
    Ptr GParamSpec ->                       -- pspec : TParamSpec
    IO CInt

-- | Validates the initial and final values of /@interval@/ against
-- a t'GI.GObject.Objects.ParamSpec.ParamSpec'.
-- 
-- /Since: 1.0/
intervalValidate ::
    (B.CallStack.HasCallStack, MonadIO m, IsInterval a) =>
    a
    -- ^ /@interval@/: a t'GI.Clutter.Objects.Interval.Interval'
    -> GParamSpec
    -- ^ /@pspec@/: a t'GI.GObject.Objects.ParamSpec.ParamSpec'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the t'GI.Clutter.Objects.Interval.Interval' is valid, 'P.False' otherwise
intervalValidate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInterval a) =>
a -> GParamSpec -> m Bool
intervalValidate a
interval GParamSpec
pspec = 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 Interval
interval' <- a -> IO (Ptr Interval)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
interval
    Ptr GParamSpec
pspec' <- GParamSpec -> IO (Ptr GParamSpec)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GParamSpec
pspec
    CInt
result <- Ptr Interval -> Ptr GParamSpec -> IO CInt
clutter_interval_validate Ptr Interval
interval' Ptr GParamSpec
pspec'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
interval
    GParamSpec -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GParamSpec
pspec
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data IntervalValidateMethodInfo
instance (signature ~ (GParamSpec -> m Bool), MonadIO m, IsInterval a) => O.OverloadedMethod IntervalValidateMethodInfo a signature where
    overloadedMethod = intervalValidate

instance O.OverloadedMethodInfo IntervalValidateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Clutter.Objects.Interval.intervalValidate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-clutter-1.0.3/docs/GI-Clutter-Objects-Interval.html#v:intervalValidate"
        })


#endif