{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A time-based [class/@animation@/].
-- 
-- @AdwTimedAnimation@ implements a simple animation interpolating the given
-- value from [property/@timedAnimation@/:value-from] to
-- [property/@timedAnimation@/:value-to] over
-- [property/@timedAnimation@/:duration] milliseconds using the curve described by
-- [property/@timedAnimation@/:easing].
-- 
-- If [property/@timedAnimation@/:reverse] is set to @TRUE@, @AdwTimedAnimation@
-- will instead animate from [property/@timedAnimation@/:value-to] to
-- [property/@timedAnimation@/:value-from], and the easing curve will be inverted.
-- 
-- The animation can repeat a certain amount of times, or endlessly, depending
-- on the [property/@timedAnimation@/:repeat-count] value. If
-- [property/@timedAnimation@/:alternate] is set to @TRUE@, it will also change the
-- direction every other iteration.

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

module GI.Adw.Objects.TimedAnimation
    ( 

-- * Exported types
    TimedAnimation(..)                      ,
    IsTimedAnimation                        ,
    toTimedAnimation                        ,


 -- * 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"), [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"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [pause]("GI.Adw.Objects.Animation#g:method:pause"), [play]("GI.Adw.Objects.Animation#g:method:play"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reset]("GI.Adw.Objects.Animation#g:method:reset"), [resume]("GI.Adw.Objects.Animation#g:method:resume"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [skip]("GI.Adw.Objects.Animation#g:method:skip"), [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"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAlternate]("GI.Adw.Objects.TimedAnimation#g:method:getAlternate"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDuration]("GI.Adw.Objects.TimedAnimation#g:method:getDuration"), [getEasing]("GI.Adw.Objects.TimedAnimation#g:method:getEasing"), [getFollowEnableAnimationsSetting]("GI.Adw.Objects.Animation#g:method:getFollowEnableAnimationsSetting"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRepeatCount]("GI.Adw.Objects.TimedAnimation#g:method:getRepeatCount"), [getReverse]("GI.Adw.Objects.TimedAnimation#g:method:getReverse"), [getState]("GI.Adw.Objects.Animation#g:method:getState"), [getTarget]("GI.Adw.Objects.Animation#g:method:getTarget"), [getValue]("GI.Adw.Objects.Animation#g:method:getValue"), [getValueFrom]("GI.Adw.Objects.TimedAnimation#g:method:getValueFrom"), [getValueTo]("GI.Adw.Objects.TimedAnimation#g:method:getValueTo"), [getWidget]("GI.Adw.Objects.Animation#g:method:getWidget").
-- 
-- ==== Setters
-- [setAlternate]("GI.Adw.Objects.TimedAnimation#g:method:setAlternate"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDuration]("GI.Adw.Objects.TimedAnimation#g:method:setDuration"), [setEasing]("GI.Adw.Objects.TimedAnimation#g:method:setEasing"), [setFollowEnableAnimationsSetting]("GI.Adw.Objects.Animation#g:method:setFollowEnableAnimationsSetting"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setRepeatCount]("GI.Adw.Objects.TimedAnimation#g:method:setRepeatCount"), [setReverse]("GI.Adw.Objects.TimedAnimation#g:method:setReverse"), [setTarget]("GI.Adw.Objects.Animation#g:method:setTarget"), [setValueFrom]("GI.Adw.Objects.TimedAnimation#g:method:setValueFrom"), [setValueTo]("GI.Adw.Objects.TimedAnimation#g:method:setValueTo").

#if defined(ENABLE_OVERLOADING)
    ResolveTimedAnimationMethod             ,
#endif

-- ** getAlternate #method:getAlternate#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetAlternateMethodInfo    ,
#endif
    timedAnimationGetAlternate              ,


-- ** getDuration #method:getDuration#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetDurationMethodInfo     ,
#endif
    timedAnimationGetDuration               ,


-- ** getEasing #method:getEasing#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetEasingMethodInfo       ,
#endif
    timedAnimationGetEasing                 ,


-- ** getRepeatCount #method:getRepeatCount#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetRepeatCountMethodInfo  ,
#endif
    timedAnimationGetRepeatCount            ,


-- ** getReverse #method:getReverse#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetReverseMethodInfo      ,
#endif
    timedAnimationGetReverse                ,


-- ** getValueFrom #method:getValueFrom#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetValueFromMethodInfo    ,
#endif
    timedAnimationGetValueFrom              ,


-- ** getValueTo #method:getValueTo#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationGetValueToMethodInfo      ,
#endif
    timedAnimationGetValueTo                ,


-- ** new #method:new#

    timedAnimationNew                       ,


-- ** setAlternate #method:setAlternate#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetAlternateMethodInfo    ,
#endif
    timedAnimationSetAlternate              ,


-- ** setDuration #method:setDuration#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetDurationMethodInfo     ,
#endif
    timedAnimationSetDuration               ,


-- ** setEasing #method:setEasing#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetEasingMethodInfo       ,
#endif
    timedAnimationSetEasing                 ,


-- ** setRepeatCount #method:setRepeatCount#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetRepeatCountMethodInfo  ,
#endif
    timedAnimationSetRepeatCount            ,


-- ** setReverse #method:setReverse#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetReverseMethodInfo      ,
#endif
    timedAnimationSetReverse                ,


-- ** setValueFrom #method:setValueFrom#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetValueFromMethodInfo    ,
#endif
    timedAnimationSetValueFrom              ,


-- ** setValueTo #method:setValueTo#

#if defined(ENABLE_OVERLOADING)
    TimedAnimationSetValueToMethodInfo      ,
#endif
    timedAnimationSetValueTo                ,




 -- * Properties


-- ** alternate #attr:alternate#
-- | Whether the animation changes direction on every iteration.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationAlternatePropertyInfo     ,
#endif
    constructTimedAnimationAlternate        ,
    getTimedAnimationAlternate              ,
    setTimedAnimationAlternate              ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationAlternate                 ,
#endif


-- ** duration #attr:duration#
-- | Duration of the animation, in milliseconds.
-- 
-- Describes how much time the animation will take.
-- 
-- If the animation repeats more than once, describes the duration of one
-- iteration.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationDurationPropertyInfo      ,
#endif
    constructTimedAnimationDuration         ,
    getTimedAnimationDuration               ,
    setTimedAnimationDuration               ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationDuration                  ,
#endif


-- ** easing #attr:easing#
-- | Easing function used in the animation.
-- 
-- Describes the curve the value is interpolated on.
-- 
-- See [enum/@easing@/] for the description of specific easing functions.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationEasingPropertyInfo        ,
#endif
    constructTimedAnimationEasing           ,
    getTimedAnimationEasing                 ,
    setTimedAnimationEasing                 ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationEasing                    ,
#endif


-- ** repeatCount #attr:repeatCount#
-- | Number of times the animation will play.
-- 
-- If set to 0, the animation will repeat endlessly.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationRepeatCountPropertyInfo   ,
#endif
    constructTimedAnimationRepeatCount      ,
    getTimedAnimationRepeatCount            ,
    setTimedAnimationRepeatCount            ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationRepeatCount               ,
#endif


-- ** reverse #attr:reverse#
-- | Whether the animation plays backwards.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationReversePropertyInfo       ,
#endif
    constructTimedAnimationReverse          ,
    getTimedAnimationReverse                ,
    setTimedAnimationReverse                ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationReverse                   ,
#endif


-- ** valueFrom #attr:valueFrom#
-- | The value to animate from.
-- 
-- The animation will start at this value and end at
-- [property/@timedAnimation@/:value-to].
-- 
-- If [property/@timedAnimation@/:reverse] is @TRUE@, the animation will end at
-- this value instead.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationValueFromPropertyInfo     ,
#endif
    constructTimedAnimationValueFrom        ,
    getTimedAnimationValueFrom              ,
    setTimedAnimationValueFrom              ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationValueFrom                 ,
#endif


-- ** valueTo #attr:valueTo#
-- | The value to animate to.
-- 
-- The animation will start at [property/@timedAnimation@/:value-from] and end at
-- this value.
-- 
-- If [property/@timedAnimation@/:reverse] is @TRUE@, the animation will start
-- at this value instead.

#if defined(ENABLE_OVERLOADING)
    TimedAnimationValueToPropertyInfo       ,
#endif
    constructTimedAnimationValueTo          ,
    getTimedAnimationValueTo                ,
    setTimedAnimationValueTo                ,
#if defined(ENABLE_OVERLOADING)
    timedAnimationValueTo                   ,
#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.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import {-# SOURCE #-} qualified GI.Adw.Objects.Animation as Adw.Animation
import {-# SOURCE #-} qualified GI.Adw.Objects.AnimationTarget as Adw.AnimationTarget
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "adw_timed_animation_get_type"
    c_adw_timed_animation_get_type :: IO B.Types.GType

instance B.Types.TypedObject TimedAnimation where
    glibType :: IO GType
glibType = IO GType
c_adw_timed_animation_get_type

instance B.Types.GObject TimedAnimation

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

instance O.HasParentTypes TimedAnimation
type instance O.ParentTypes TimedAnimation = '[Adw.Animation.Animation, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveTimedAnimationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveTimedAnimationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveTimedAnimationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveTimedAnimationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveTimedAnimationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveTimedAnimationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveTimedAnimationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveTimedAnimationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveTimedAnimationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveTimedAnimationMethod "pause" o = Adw.Animation.AnimationPauseMethodInfo
    ResolveTimedAnimationMethod "play" o = Adw.Animation.AnimationPlayMethodInfo
    ResolveTimedAnimationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveTimedAnimationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveTimedAnimationMethod "reset" o = Adw.Animation.AnimationResetMethodInfo
    ResolveTimedAnimationMethod "resume" o = Adw.Animation.AnimationResumeMethodInfo
    ResolveTimedAnimationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveTimedAnimationMethod "skip" o = Adw.Animation.AnimationSkipMethodInfo
    ResolveTimedAnimationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveTimedAnimationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveTimedAnimationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveTimedAnimationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveTimedAnimationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveTimedAnimationMethod "getAlternate" o = TimedAnimationGetAlternateMethodInfo
    ResolveTimedAnimationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveTimedAnimationMethod "getDuration" o = TimedAnimationGetDurationMethodInfo
    ResolveTimedAnimationMethod "getEasing" o = TimedAnimationGetEasingMethodInfo
    ResolveTimedAnimationMethod "getFollowEnableAnimationsSetting" o = Adw.Animation.AnimationGetFollowEnableAnimationsSettingMethodInfo
    ResolveTimedAnimationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveTimedAnimationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveTimedAnimationMethod "getRepeatCount" o = TimedAnimationGetRepeatCountMethodInfo
    ResolveTimedAnimationMethod "getReverse" o = TimedAnimationGetReverseMethodInfo
    ResolveTimedAnimationMethod "getState" o = Adw.Animation.AnimationGetStateMethodInfo
    ResolveTimedAnimationMethod "getTarget" o = Adw.Animation.AnimationGetTargetMethodInfo
    ResolveTimedAnimationMethod "getValue" o = Adw.Animation.AnimationGetValueMethodInfo
    ResolveTimedAnimationMethod "getValueFrom" o = TimedAnimationGetValueFromMethodInfo
    ResolveTimedAnimationMethod "getValueTo" o = TimedAnimationGetValueToMethodInfo
    ResolveTimedAnimationMethod "getWidget" o = Adw.Animation.AnimationGetWidgetMethodInfo
    ResolveTimedAnimationMethod "setAlternate" o = TimedAnimationSetAlternateMethodInfo
    ResolveTimedAnimationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveTimedAnimationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveTimedAnimationMethod "setDuration" o = TimedAnimationSetDurationMethodInfo
    ResolveTimedAnimationMethod "setEasing" o = TimedAnimationSetEasingMethodInfo
    ResolveTimedAnimationMethod "setFollowEnableAnimationsSetting" o = Adw.Animation.AnimationSetFollowEnableAnimationsSettingMethodInfo
    ResolveTimedAnimationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveTimedAnimationMethod "setRepeatCount" o = TimedAnimationSetRepeatCountMethodInfo
    ResolveTimedAnimationMethod "setReverse" o = TimedAnimationSetReverseMethodInfo
    ResolveTimedAnimationMethod "setTarget" o = Adw.Animation.AnimationSetTargetMethodInfo
    ResolveTimedAnimationMethod "setValueFrom" o = TimedAnimationSetValueFromMethodInfo
    ResolveTimedAnimationMethod "setValueTo" o = TimedAnimationSetValueToMethodInfo
    ResolveTimedAnimationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "alternate"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@alternate@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #alternate 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationAlternate :: (MonadIO m, IsTimedAnimation o) => o -> Bool -> m ()
setTimedAnimationAlternate :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Bool -> m ()
setTimedAnimationAlternate o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"alternate" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@alternate@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationAlternate :: (IsTimedAnimation o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTimedAnimationAlternate :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTimedAnimationAlternate Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"alternate" Bool
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationAlternatePropertyInfo
instance AttrInfo TimedAnimationAlternatePropertyInfo where
    type AttrAllowedOps TimedAnimationAlternatePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationAlternatePropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationAlternatePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TimedAnimationAlternatePropertyInfo = (~) Bool
    type AttrTransferType TimedAnimationAlternatePropertyInfo = Bool
    type AttrGetType TimedAnimationAlternatePropertyInfo = Bool
    type AttrLabel TimedAnimationAlternatePropertyInfo = "alternate"
    type AttrOrigin TimedAnimationAlternatePropertyInfo = TimedAnimation
    attrGet = getTimedAnimationAlternate
    attrSet = setTimedAnimationAlternate
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationAlternate
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.alternate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:alternate"
        })
#endif

-- VVV Prop "duration"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #duration 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationDuration :: (MonadIO m, IsTimedAnimation o) => o -> Word32 -> m ()
setTimedAnimationDuration :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Word32 -> m ()
setTimedAnimationDuration o
obj Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"duration" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@duration@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationDuration :: (IsTimedAnimation o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructTimedAnimationDuration :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructTimedAnimationDuration Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"duration" Word32
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationDurationPropertyInfo
instance AttrInfo TimedAnimationDurationPropertyInfo where
    type AttrAllowedOps TimedAnimationDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationDurationPropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationDurationPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint TimedAnimationDurationPropertyInfo = (~) Word32
    type AttrTransferType TimedAnimationDurationPropertyInfo = Word32
    type AttrGetType TimedAnimationDurationPropertyInfo = Word32
    type AttrLabel TimedAnimationDurationPropertyInfo = "duration"
    type AttrOrigin TimedAnimationDurationPropertyInfo = TimedAnimation
    attrGet = getTimedAnimationDuration
    attrSet = setTimedAnimationDuration
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.duration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:duration"
        })
#endif

-- VVV Prop "easing"
   -- Type: TInterface (Name {namespace = "Adw", name = "Easing"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@easing@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' timedAnimation #easing
-- @
getTimedAnimationEasing :: (MonadIO m, IsTimedAnimation o) => o -> m Adw.Enums.Easing
getTimedAnimationEasing :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> m Easing
getTimedAnimationEasing o
obj = IO Easing -> m Easing
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Easing -> m Easing) -> IO Easing -> m Easing
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Easing
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"easing"

-- | Set the value of the “@easing@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #easing 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationEasing :: (MonadIO m, IsTimedAnimation o) => o -> Adw.Enums.Easing -> m ()
setTimedAnimationEasing :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Easing -> m ()
setTimedAnimationEasing o
obj Easing
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 -> Easing -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"easing" Easing
val

-- | Construct a `GValueConstruct` with valid value for the “@easing@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationEasing :: (IsTimedAnimation o, MIO.MonadIO m) => Adw.Enums.Easing -> m (GValueConstruct o)
constructTimedAnimationEasing :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Easing -> m (GValueConstruct o)
constructTimedAnimationEasing Easing
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 -> Easing -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"easing" Easing
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationEasingPropertyInfo
instance AttrInfo TimedAnimationEasingPropertyInfo where
    type AttrAllowedOps TimedAnimationEasingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationEasingPropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationEasingPropertyInfo = (~) Adw.Enums.Easing
    type AttrTransferTypeConstraint TimedAnimationEasingPropertyInfo = (~) Adw.Enums.Easing
    type AttrTransferType TimedAnimationEasingPropertyInfo = Adw.Enums.Easing
    type AttrGetType TimedAnimationEasingPropertyInfo = Adw.Enums.Easing
    type AttrLabel TimedAnimationEasingPropertyInfo = "easing"
    type AttrOrigin TimedAnimationEasingPropertyInfo = TimedAnimation
    attrGet = getTimedAnimationEasing
    attrSet = setTimedAnimationEasing
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationEasing
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.easing"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:easing"
        })
#endif

-- VVV Prop "repeat-count"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@repeat-count@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' timedAnimation #repeatCount
-- @
getTimedAnimationRepeatCount :: (MonadIO m, IsTimedAnimation o) => o -> m Word32
getTimedAnimationRepeatCount :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> m Word32
getTimedAnimationRepeatCount o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"repeat-count"

-- | Set the value of the “@repeat-count@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #repeatCount 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationRepeatCount :: (MonadIO m, IsTimedAnimation o) => o -> Word32 -> m ()
setTimedAnimationRepeatCount :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Word32 -> m ()
setTimedAnimationRepeatCount o
obj Word32
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 -> Word32 -> IO ()
forall a. GObject a => a -> String -> Word32 -> IO ()
B.Properties.setObjectPropertyUInt32 o
obj String
"repeat-count" Word32
val

-- | Construct a `GValueConstruct` with valid value for the “@repeat-count@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationRepeatCount :: (IsTimedAnimation o, MIO.MonadIO m) => Word32 -> m (GValueConstruct o)
constructTimedAnimationRepeatCount :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Word32 -> m (GValueConstruct o)
constructTimedAnimationRepeatCount Word32
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 -> Word32 -> IO (GValueConstruct o)
forall o. String -> Word32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyUInt32 String
"repeat-count" Word32
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationRepeatCountPropertyInfo
instance AttrInfo TimedAnimationRepeatCountPropertyInfo where
    type AttrAllowedOps TimedAnimationRepeatCountPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationRepeatCountPropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationRepeatCountPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint TimedAnimationRepeatCountPropertyInfo = (~) Word32
    type AttrTransferType TimedAnimationRepeatCountPropertyInfo = Word32
    type AttrGetType TimedAnimationRepeatCountPropertyInfo = Word32
    type AttrLabel TimedAnimationRepeatCountPropertyInfo = "repeat-count"
    type AttrOrigin TimedAnimationRepeatCountPropertyInfo = TimedAnimation
    attrGet = getTimedAnimationRepeatCount
    attrSet = setTimedAnimationRepeatCount
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationRepeatCount
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.repeatCount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:repeatCount"
        })
#endif

-- VVV Prop "reverse"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@reverse@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #reverse 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationReverse :: (MonadIO m, IsTimedAnimation o) => o -> Bool -> m ()
setTimedAnimationReverse :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Bool -> m ()
setTimedAnimationReverse o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"reverse" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@reverse@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationReverse :: (IsTimedAnimation o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructTimedAnimationReverse :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructTimedAnimationReverse Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"reverse" Bool
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationReversePropertyInfo
instance AttrInfo TimedAnimationReversePropertyInfo where
    type AttrAllowedOps TimedAnimationReversePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationReversePropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationReversePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint TimedAnimationReversePropertyInfo = (~) Bool
    type AttrTransferType TimedAnimationReversePropertyInfo = Bool
    type AttrGetType TimedAnimationReversePropertyInfo = Bool
    type AttrLabel TimedAnimationReversePropertyInfo = "reverse"
    type AttrOrigin TimedAnimationReversePropertyInfo = TimedAnimation
    attrGet = getTimedAnimationReverse
    attrSet = setTimedAnimationReverse
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationReverse
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.reverse"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:reverse"
        })
#endif

-- VVV Prop "value-from"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@value-from@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #valueFrom 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationValueFrom :: (MonadIO m, IsTimedAnimation o) => o -> Double -> m ()
setTimedAnimationValueFrom :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Double -> m ()
setTimedAnimationValueFrom o
obj Double
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 -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"value-from" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@value-from@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationValueFrom :: (IsTimedAnimation o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructTimedAnimationValueFrom :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructTimedAnimationValueFrom Double
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 -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"value-from" Double
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationValueFromPropertyInfo
instance AttrInfo TimedAnimationValueFromPropertyInfo where
    type AttrAllowedOps TimedAnimationValueFromPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationValueFromPropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationValueFromPropertyInfo = (~) Double
    type AttrTransferTypeConstraint TimedAnimationValueFromPropertyInfo = (~) Double
    type AttrTransferType TimedAnimationValueFromPropertyInfo = Double
    type AttrGetType TimedAnimationValueFromPropertyInfo = Double
    type AttrLabel TimedAnimationValueFromPropertyInfo = "value-from"
    type AttrOrigin TimedAnimationValueFromPropertyInfo = TimedAnimation
    attrGet = getTimedAnimationValueFrom
    attrSet = setTimedAnimationValueFrom
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationValueFrom
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.valueFrom"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:valueFrom"
        })
#endif

-- VVV Prop "value-to"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@value-to@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' timedAnimation [ #valueTo 'Data.GI.Base.Attributes.:=' value ]
-- @
setTimedAnimationValueTo :: (MonadIO m, IsTimedAnimation o) => o -> Double -> m ()
setTimedAnimationValueTo :: forall (m :: * -> *) o.
(MonadIO m, IsTimedAnimation o) =>
o -> Double -> m ()
setTimedAnimationValueTo o
obj Double
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 -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"value-to" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@value-to@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructTimedAnimationValueTo :: (IsTimedAnimation o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructTimedAnimationValueTo :: forall o (m :: * -> *).
(IsTimedAnimation o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructTimedAnimationValueTo Double
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 -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"value-to" Double
val

#if defined(ENABLE_OVERLOADING)
data TimedAnimationValueToPropertyInfo
instance AttrInfo TimedAnimationValueToPropertyInfo where
    type AttrAllowedOps TimedAnimationValueToPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint TimedAnimationValueToPropertyInfo = IsTimedAnimation
    type AttrSetTypeConstraint TimedAnimationValueToPropertyInfo = (~) Double
    type AttrTransferTypeConstraint TimedAnimationValueToPropertyInfo = (~) Double
    type AttrTransferType TimedAnimationValueToPropertyInfo = Double
    type AttrGetType TimedAnimationValueToPropertyInfo = Double
    type AttrLabel TimedAnimationValueToPropertyInfo = "value-to"
    type AttrOrigin TimedAnimationValueToPropertyInfo = TimedAnimation
    attrGet = getTimedAnimationValueTo
    attrSet = setTimedAnimationValueTo
    attrTransfer _ v = do
        return v
    attrConstruct = constructTimedAnimationValueTo
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.valueTo"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#g:attr:valueTo"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList TimedAnimation
type instance O.AttributeList TimedAnimation = TimedAnimationAttributeList
type TimedAnimationAttributeList = ('[ '("alternate", TimedAnimationAlternatePropertyInfo), '("duration", TimedAnimationDurationPropertyInfo), '("easing", TimedAnimationEasingPropertyInfo), '("followEnableAnimationsSetting", Adw.Animation.AnimationFollowEnableAnimationsSettingPropertyInfo), '("repeatCount", TimedAnimationRepeatCountPropertyInfo), '("reverse", TimedAnimationReversePropertyInfo), '("state", Adw.Animation.AnimationStatePropertyInfo), '("target", Adw.Animation.AnimationTargetPropertyInfo), '("value", Adw.Animation.AnimationValuePropertyInfo), '("valueFrom", TimedAnimationValueFromPropertyInfo), '("valueTo", TimedAnimationValueToPropertyInfo), '("widget", Adw.Animation.AnimationWidgetPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
timedAnimationAlternate :: AttrLabelProxy "alternate"
timedAnimationAlternate = AttrLabelProxy

timedAnimationDuration :: AttrLabelProxy "duration"
timedAnimationDuration = AttrLabelProxy

timedAnimationEasing :: AttrLabelProxy "easing"
timedAnimationEasing = AttrLabelProxy

timedAnimationRepeatCount :: AttrLabelProxy "repeatCount"
timedAnimationRepeatCount = AttrLabelProxy

timedAnimationReverse :: AttrLabelProxy "reverse"
timedAnimationReverse = AttrLabelProxy

timedAnimationValueFrom :: AttrLabelProxy "valueFrom"
timedAnimationValueFrom = AttrLabelProxy

timedAnimationValueTo :: AttrLabelProxy "valueTo"
timedAnimationValueTo = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList TimedAnimation = TimedAnimationSignalList
type TimedAnimationSignalList = ('[ '("done", Adw.Animation.AnimationDoneSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method TimedAnimation::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a widget to create animation on"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to animate from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a value to animate to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a duration for the animation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "AnimationTarget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a target value to animate"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "TimedAnimation" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_new" adw_timed_animation_new :: 
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CDouble ->                              -- from : TBasicType TDouble
    CDouble ->                              -- to : TBasicType TDouble
    Word32 ->                               -- duration : TBasicType TUInt
    Ptr Adw.AnimationTarget.AnimationTarget -> -- target : TInterface (Name {namespace = "Adw", name = "AnimationTarget"})
    IO (Ptr TimedAnimation)

-- | Creates a new @AdwTimedAnimation@ on /@widget@/ to animate /@target@/ from /@from@/
-- to /@to@/.
timedAnimationNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gtk.Widget.IsWidget a, Adw.AnimationTarget.IsAnimationTarget b) =>
    a
    -- ^ /@widget@/: a widget to create animation on
    -> Double
    -- ^ /@from@/: a value to animate from
    -> Double
    -- ^ /@to@/: a value to animate to
    -> Word32
    -- ^ /@duration@/: a duration for the animation
    -> b
    -- ^ /@target@/: a target value to animate
    -> m TimedAnimation
    -- ^ __Returns:__ the newly created animation
timedAnimationNew :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsWidget a, IsAnimationTarget b) =>
a -> Double -> Double -> Word32 -> b -> m TimedAnimation
timedAnimationNew a
widget Double
from Double
to Word32
duration b
target = IO TimedAnimation -> m TimedAnimation
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimedAnimation -> m TimedAnimation)
-> IO TimedAnimation -> m TimedAnimation
forall a b. (a -> b) -> a -> b
$ do
    Ptr Widget
widget' <- a -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
widget
    let from' :: CDouble
from' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
from
    let to' :: CDouble
to' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
to
    Ptr AnimationTarget
target' <- b -> IO (Ptr AnimationTarget)
forall a b. (HasCallStack, GObject a) => a -> IO (Ptr b)
B.ManagedPtr.disownObject b
target
    Ptr TimedAnimation
result <- Ptr Widget
-> CDouble
-> CDouble
-> Word32
-> Ptr AnimationTarget
-> IO (Ptr TimedAnimation)
adw_timed_animation_new Ptr Widget
widget' CDouble
from' CDouble
to' Word32
duration Ptr AnimationTarget
target'
    Text -> Ptr TimedAnimation -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"timedAnimationNew" Ptr TimedAnimation
result
    TimedAnimation
result' <- ((ManagedPtr TimedAnimation -> TimedAnimation)
-> Ptr TimedAnimation -> IO TimedAnimation
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr TimedAnimation -> TimedAnimation
TimedAnimation) Ptr TimedAnimation
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
widget
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    TimedAnimation -> IO TimedAnimation
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TimedAnimation
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method TimedAnimation::get_alternate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , 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 "adw_timed_animation_get_alternate" adw_timed_animation_get_alternate :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO CInt

-- | Gets whether /@self@/ changes direction on every iteration.
timedAnimationGetAlternate ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ alternates
timedAnimationGetAlternate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Bool
timedAnimationGetAlternate a
self = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TimedAnimation -> IO CInt
adw_timed_animation_get_alternate Ptr TimedAnimation
self'
    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
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetAlternateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetAlternateMethodInfo a signature where
    overloadedMethod = timedAnimationGetAlternate

instance O.OverloadedMethodInfo TimedAnimationGetAlternateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetAlternate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetAlternate"
        })


#endif

-- method TimedAnimation::get_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_get_duration" adw_timed_animation_get_duration :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO Word32

-- | Gets the duration of /@self@/.
timedAnimationGetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Word32
    -- ^ __Returns:__ the duration of /@self@/, in milliseconds
timedAnimationGetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Word32
timedAnimationGetDuration a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr TimedAnimation -> IO Word32
adw_timed_animation_get_duration Ptr TimedAnimation
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetDurationMethodInfo a signature where
    overloadedMethod = timedAnimationGetDuration

instance O.OverloadedMethodInfo TimedAnimationGetDurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetDuration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetDuration"
        })


#endif

-- method TimedAnimation::get_easing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Adw" , name = "Easing" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_get_easing" adw_timed_animation_get_easing :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO CUInt

-- | Gets the easing function /@self@/ uses.
timedAnimationGetEasing ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Adw.Enums.Easing
    -- ^ __Returns:__ the easing function /@self@/ uses
timedAnimationGetEasing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Easing
timedAnimationGetEasing a
self = IO Easing -> m Easing
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Easing -> m Easing) -> IO Easing -> m Easing
forall a b. (a -> b) -> a -> b
$ do
    Ptr TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr TimedAnimation -> IO CUInt
adw_timed_animation_get_easing Ptr TimedAnimation
self'
    let result' :: Easing
result' = (Int -> Easing
forall a. Enum a => Int -> a
toEnum (Int -> Easing) -> (CUInt -> Int) -> CUInt -> Easing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Easing -> IO Easing
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Easing
result'

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetEasingMethodInfo
instance (signature ~ (m Adw.Enums.Easing), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetEasingMethodInfo a signature where
    overloadedMethod = timedAnimationGetEasing

instance O.OverloadedMethodInfo TimedAnimationGetEasingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetEasing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetEasing"
        })


#endif

-- method TimedAnimation::get_repeat_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_get_repeat_count" adw_timed_animation_get_repeat_count :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO Word32

-- | Gets the number of times /@self@/ will play.
timedAnimationGetRepeatCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Word32
    -- ^ __Returns:__ the number of times /@self@/ will play
timedAnimationGetRepeatCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Word32
timedAnimationGetRepeatCount a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr TimedAnimation -> IO Word32
adw_timed_animation_get_repeat_count Ptr TimedAnimation
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetRepeatCountMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetRepeatCountMethodInfo a signature where
    overloadedMethod = timedAnimationGetRepeatCount

instance O.OverloadedMethodInfo TimedAnimationGetRepeatCountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetRepeatCount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetRepeatCount"
        })


#endif

-- method TimedAnimation::get_reverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , 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 "adw_timed_animation_get_reverse" adw_timed_animation_get_reverse :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO CInt

-- | Gets whether /@self@/ plays backwards.
timedAnimationGetReverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Bool
    -- ^ __Returns:__ whether /@self@/ plays backwards
timedAnimationGetReverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Bool
timedAnimationGetReverse a
self = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr TimedAnimation -> IO CInt
adw_timed_animation_get_reverse Ptr TimedAnimation
self'
    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
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetReverseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetReverseMethodInfo a signature where
    overloadedMethod = timedAnimationGetReverse

instance O.OverloadedMethodInfo TimedAnimationGetReverseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetReverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetReverse"
        })


#endif

-- method TimedAnimation::get_value_from
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , 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 "adw_timed_animation_get_value_from" adw_timed_animation_get_value_from :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO CDouble

-- | Gets the value /@self@/ will animate from.
timedAnimationGetValueFrom ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Double
    -- ^ __Returns:__ the value to animate from
timedAnimationGetValueFrom :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Double
timedAnimationGetValueFrom a
self = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr TimedAnimation -> IO CDouble
adw_timed_animation_get_value_from Ptr TimedAnimation
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetValueFromMethodInfo
instance (signature ~ (m Double), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetValueFromMethodInfo a signature where
    overloadedMethod = timedAnimationGetValueFrom

instance O.OverloadedMethodInfo TimedAnimationGetValueFromMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetValueFrom",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetValueFrom"
        })


#endif

-- method TimedAnimation::get_value_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , 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 "adw_timed_animation_get_value_to" adw_timed_animation_get_value_to :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    IO CDouble

-- | Gets the value /@self@/ will animate to.
timedAnimationGetValueTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> m Double
    -- ^ __Returns:__ the value to animate to
timedAnimationGetValueTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> m Double
timedAnimationGetValueTo a
self = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr TimedAnimation -> IO CDouble
adw_timed_animation_get_value_to Ptr TimedAnimation
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data TimedAnimationGetValueToMethodInfo
instance (signature ~ (m Double), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationGetValueToMethodInfo a signature where
    overloadedMethod = timedAnimationGetValueTo

instance O.OverloadedMethodInfo TimedAnimationGetValueToMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationGetValueTo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationGetValueTo"
        })


#endif

-- method TimedAnimation::set_alternate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "alternate"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether @self alternates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_alternate" adw_timed_animation_set_alternate :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    CInt ->                                 -- alternate : TBasicType TBoolean
    IO ()

-- | Sets whether /@self@/ changes direction on every iteration.
timedAnimationSetAlternate ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Bool
    -- ^ /@alternate@/: whether /@self@/ alternates
    -> m ()
timedAnimationSetAlternate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Bool -> m ()
timedAnimationSetAlternate a
self Bool
alternate = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let alternate' :: CInt
alternate' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
alternate
    Ptr TimedAnimation -> CInt -> IO ()
adw_timed_animation_set_alternate Ptr TimedAnimation
self' CInt
alternate'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetAlternateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetAlternateMethodInfo a signature where
    overloadedMethod = timedAnimationSetAlternate

instance O.OverloadedMethodInfo TimedAnimationSetAlternateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetAlternate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetAlternate"
        })


#endif

-- method TimedAnimation::set_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the duration to use, in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_duration" adw_timed_animation_set_duration :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    Word32 ->                               -- duration : TBasicType TUInt
    IO ()

-- | Sets the duration of /@self@/.
-- 
-- If the animation repeats more than once, sets the duration of one iteration.
timedAnimationSetDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Word32
    -- ^ /@duration@/: the duration to use, in milliseconds
    -> m ()
timedAnimationSetDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Word32 -> m ()
timedAnimationSetDuration a
self Word32
duration = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TimedAnimation -> Word32 -> IO ()
adw_timed_animation_set_duration Ptr TimedAnimation
self' Word32
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetDurationMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetDurationMethodInfo a signature where
    overloadedMethod = timedAnimationSetDuration

instance O.OverloadedMethodInfo TimedAnimationSetDurationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetDuration",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetDuration"
        })


#endif

-- method TimedAnimation::set_easing
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "easing"
--           , argType = TInterface Name { namespace = "Adw" , name = "Easing" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the easing function to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_easing" adw_timed_animation_set_easing :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    CUInt ->                                -- easing : TInterface (Name {namespace = "Adw", name = "Easing"})
    IO ()

-- | Sets the easing function /@self@/ will use.
-- 
-- See [enum/@easing@/] for the description of specific easing functions.
timedAnimationSetEasing ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Adw.Enums.Easing
    -- ^ /@easing@/: the easing function to use
    -> m ()
timedAnimationSetEasing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Easing -> m ()
timedAnimationSetEasing a
self Easing
easing = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let easing' :: CUInt
easing' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Easing -> Int) -> Easing -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Easing -> Int
forall a. Enum a => a -> Int
fromEnum) Easing
easing
    Ptr TimedAnimation -> CUInt -> IO ()
adw_timed_animation_set_easing Ptr TimedAnimation
self' CUInt
easing'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetEasingMethodInfo
instance (signature ~ (Adw.Enums.Easing -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetEasingMethodInfo a signature where
    overloadedMethod = timedAnimationSetEasing

instance O.OverloadedMethodInfo TimedAnimationSetEasingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetEasing",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetEasing"
        })


#endif

-- method TimedAnimation::set_repeat_count
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "repeat_count"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of times @self will play"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_repeat_count" adw_timed_animation_set_repeat_count :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    Word32 ->                               -- repeat_count : TBasicType TUInt
    IO ()

-- | Sets the number of times /@self@/ will play.
-- 
-- If set to 0, /@self@/ will repeat endlessly.
timedAnimationSetRepeatCount ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Word32
    -- ^ /@repeatCount@/: the number of times /@self@/ will play
    -> m ()
timedAnimationSetRepeatCount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Word32 -> m ()
timedAnimationSetRepeatCount a
self Word32
repeatCount = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr TimedAnimation -> Word32 -> IO ()
adw_timed_animation_set_repeat_count Ptr TimedAnimation
self' Word32
repeatCount
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetRepeatCountMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetRepeatCountMethodInfo a signature where
    overloadedMethod = timedAnimationSetRepeatCount

instance O.OverloadedMethodInfo TimedAnimationSetRepeatCountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetRepeatCount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetRepeatCount"
        })


#endif

-- method TimedAnimation::set_reverse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reverse"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether @self plays backwards"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_reverse" adw_timed_animation_set_reverse :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    CInt ->                                 -- reverse : TBasicType TBoolean
    IO ()

-- | Sets whether /@self@/ plays backwards.
timedAnimationSetReverse ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Bool
    -- ^ /@reverse@/: whether /@self@/ plays backwards
    -> m ()
timedAnimationSetReverse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Bool -> m ()
timedAnimationSetReverse a
self Bool
reverse = 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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let reverse' :: CInt
reverse' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
reverse
    Ptr TimedAnimation -> CInt -> IO ()
adw_timed_animation_set_reverse Ptr TimedAnimation
self' CInt
reverse'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetReverseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetReverseMethodInfo a signature where
    overloadedMethod = timedAnimationSetReverse

instance O.OverloadedMethodInfo TimedAnimationSetReverseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetReverse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetReverse"
        })


#endif

-- method TimedAnimation::set_value_from
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to animate from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_value_from" adw_timed_animation_set_value_from :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets the value /@self@/ will animate from.
-- 
-- The animation will start at this value and end at
-- [property/@timedAnimation@/:value-to].
-- 
-- If [property/@timedAnimation@/:reverse] is @TRUE@, the animation will end at
-- this value instead.
timedAnimationSetValueFrom ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Double
    -- ^ /@value@/: the value to animate from
    -> m ()
timedAnimationSetValueFrom :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Double -> m ()
timedAnimationSetValueFrom a
self Double
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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr TimedAnimation -> CDouble -> IO ()
adw_timed_animation_set_value_from Ptr TimedAnimation
self' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetValueFromMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetValueFromMethodInfo a signature where
    overloadedMethod = timedAnimationSetValueFrom

instance O.OverloadedMethodInfo TimedAnimationSetValueFromMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetValueFrom",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetValueFrom"
        })


#endif

-- method TimedAnimation::set_value_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "TimedAnimation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a timed animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value to animate to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_timed_animation_set_value_to" adw_timed_animation_set_value_to :: 
    Ptr TimedAnimation ->                   -- self : TInterface (Name {namespace = "Adw", name = "TimedAnimation"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets the value /@self@/ will animate to.
-- 
-- The animation will start at [property/@timedAnimation@/:value-from] and end at
-- this value.
-- 
-- If [property/@timedAnimation@/:reverse] is @TRUE@, the animation will start
-- at this value instead.
timedAnimationSetValueTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsTimedAnimation a) =>
    a
    -- ^ /@self@/: a timed animation
    -> Double
    -- ^ /@value@/: the value to animate to
    -> m ()
timedAnimationSetValueTo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsTimedAnimation a) =>
a -> Double -> m ()
timedAnimationSetValueTo a
self Double
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 TimedAnimation
self' <- a -> IO (Ptr TimedAnimation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr TimedAnimation -> CDouble -> IO ()
adw_timed_animation_set_value_to Ptr TimedAnimation
self' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data TimedAnimationSetValueToMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsTimedAnimation a) => O.OverloadedMethod TimedAnimationSetValueToMethodInfo a signature where
    overloadedMethod = timedAnimationSetValueTo

instance O.OverloadedMethodInfo TimedAnimationSetValueToMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.TimedAnimation.timedAnimationSetValueTo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-TimedAnimation.html#v:timedAnimationSetValueTo"
        })


#endif