{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A base class for animations.
-- 
-- @AdwAnimation@ represents an animation on a widget. It has a target that
-- provides a value to animate, and a state indicating whether the
-- animation hasn\'t been started yet, is playing, paused or finished.
-- 
-- Currently there are two concrete animation types:
-- [class/@timedAnimation@/] and [class/@springAnimation@/].
-- 
-- @AdwAnimation@ will automatically skip the animation if
-- [property/@animation@/:widget] is unmapped, or if
-- [Settings:gtkEnableAnimations]("GI.Gtk.Objects.Settings#g:attr:gtkEnableAnimations") is @FALSE@.
-- 
-- The [signal/@animation@/[done](#g:signal:done)] signal can be used to perform an action after
-- the animation ends, for example hiding a widget after animating its
-- [Widget:opacity]("GI.Gtk.Objects.Widget#g:attr:opacity") to 0.
-- 
-- @AdwAnimation@ will be kept alive while the animation is playing. As such,
-- it\'s safe to create an animation, start it and immediately unref it:
-- A fire-and-forget animation:
-- 
-- 
-- === /c code/
-- >static void
-- >animation_cb (double    value,
-- >              MyObject *self)
-- >{
-- >  // Do something with @value
-- >}
-- >
-- >static void
-- >my_object_animate (MyObject *self)
-- >{
-- >  AdwAnimationTarget *target =
-- >    adw_callback_animation_target_new ((AdwAnimationTargetFunc) animation_cb,
-- >                                       self, NULL);
-- >  g_autoptr (AdwAnimation) animation =
-- >    adw_timed_animation_new (widget, 0, 1, 250, target);
-- >
-- >  adw_animation_play (animation);
-- >}
-- 
-- 
-- If there\'s a chance the previous animation for the same target hasn\'t yet
-- finished, the previous animation should be stopped first, or the existing
-- @AdwAnimation@ object can be reused.

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

module GI.Adw.Objects.Animation
    ( 

-- * Exported types
    Animation(..)                           ,
    IsAnimation                             ,
    toAnimation                             ,


 -- * 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
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getFollowEnableAnimationsSetting]("GI.Adw.Objects.Animation#g:method:getFollowEnableAnimationsSetting"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getState]("GI.Adw.Objects.Animation#g:method:getState"), [getTarget]("GI.Adw.Objects.Animation#g:method:getTarget"), [getValue]("GI.Adw.Objects.Animation#g:method:getValue"), [getWidget]("GI.Adw.Objects.Animation#g:method:getWidget").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFollowEnableAnimationsSetting]("GI.Adw.Objects.Animation#g:method:setFollowEnableAnimationsSetting"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTarget]("GI.Adw.Objects.Animation#g:method:setTarget").

#if defined(ENABLE_OVERLOADING)
    ResolveAnimationMethod                  ,
#endif

-- ** getFollowEnableAnimationsSetting #method:getFollowEnableAnimationsSetting#

#if defined(ENABLE_OVERLOADING)
    AnimationGetFollowEnableAnimationsSettingMethodInfo,
#endif
    animationGetFollowEnableAnimationsSetting,


-- ** getState #method:getState#

#if defined(ENABLE_OVERLOADING)
    AnimationGetStateMethodInfo             ,
#endif
    animationGetState                       ,


-- ** getTarget #method:getTarget#

#if defined(ENABLE_OVERLOADING)
    AnimationGetTargetMethodInfo            ,
#endif
    animationGetTarget                      ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    AnimationGetValueMethodInfo             ,
#endif
    animationGetValue                       ,


-- ** getWidget #method:getWidget#

#if defined(ENABLE_OVERLOADING)
    AnimationGetWidgetMethodInfo            ,
#endif
    animationGetWidget                      ,


-- ** pause #method:pause#

#if defined(ENABLE_OVERLOADING)
    AnimationPauseMethodInfo                ,
#endif
    animationPause                          ,


-- ** play #method:play#

#if defined(ENABLE_OVERLOADING)
    AnimationPlayMethodInfo                 ,
#endif
    animationPlay                           ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    AnimationResetMethodInfo                ,
#endif
    animationReset                          ,


-- ** resume #method:resume#

#if defined(ENABLE_OVERLOADING)
    AnimationResumeMethodInfo               ,
#endif
    animationResume                         ,


-- ** setFollowEnableAnimationsSetting #method:setFollowEnableAnimationsSetting#

#if defined(ENABLE_OVERLOADING)
    AnimationSetFollowEnableAnimationsSettingMethodInfo,
#endif
    animationSetFollowEnableAnimationsSetting,


-- ** setTarget #method:setTarget#

#if defined(ENABLE_OVERLOADING)
    AnimationSetTargetMethodInfo            ,
#endif
    animationSetTarget                      ,


-- ** skip #method:skip#

#if defined(ENABLE_OVERLOADING)
    AnimationSkipMethodInfo                 ,
#endif
    animationSkip                           ,




 -- * Properties


-- ** followEnableAnimationsSetting #attr:followEnableAnimationsSetting#
-- | Whether to skip the animation when animations are globally disabled.
-- 
-- The default behavior is to skip the animation. Set to @FALSE@ to disable
-- this behavior.
-- 
-- This can be useful for cases where animation is essential, like spinners,
-- or in demo applications. Most other animations should keep it enabled.
-- 
-- See [Settings:gtkEnableAnimations]("GI.Gtk.Objects.Settings#g:attr:gtkEnableAnimations").
-- 
-- /Since: 1.3/

#if defined(ENABLE_OVERLOADING)
    AnimationFollowEnableAnimationsSettingPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    animationFollowEnableAnimationsSetting  ,
#endif
    constructAnimationFollowEnableAnimationsSetting,
    getAnimationFollowEnableAnimationsSetting,
    setAnimationFollowEnableAnimationsSetting,


-- ** state #attr:state#
-- | The animation state.
-- 
-- The state indicates whether the animation is currently playing, paused,
-- finished or hasn\'t been started yet.

#if defined(ENABLE_OVERLOADING)
    AnimationStatePropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationState                          ,
#endif
    getAnimationState                       ,


-- ** target #attr:target#
-- | The target to animate.

#if defined(ENABLE_OVERLOADING)
    AnimationTargetPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationTarget                         ,
#endif
    constructAnimationTarget                ,
    getAnimationTarget                      ,
    setAnimationTarget                      ,


-- ** value #attr:value#
-- | The current value of the animation.

#if defined(ENABLE_OVERLOADING)
    AnimationValuePropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationValue                          ,
#endif
    getAnimationValue                       ,


-- ** widget #attr:widget#
-- | The animation widget.
-- 
-- It provides the frame clock for the animation. It\'s not strictly necessary
-- for this widget to be same as the one being animated.
-- 
-- The widget must be mapped in order for the animation to work. If it\'s not
-- mapped, or if it gets unmapped during an ongoing animation, the animation
-- will be automatically skipped.

#if defined(ENABLE_OVERLOADING)
    AnimationWidgetPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    animationWidget                         ,
#endif
    constructAnimationWidget                ,
    getAnimationWidget                      ,




 -- * Signals


-- ** done #signal:done#

    AnimationDoneCallback                   ,
#if defined(ENABLE_OVERLOADING)
    AnimationDoneSignalInfo                 ,
#endif
    afterAnimationDone                      ,
    onAnimationDone                         ,




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

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

foreign import ccall "adw_animation_get_type"
    c_adw_animation_get_type :: IO B.Types.GType

instance B.Types.TypedObject Animation where
    glibType :: IO GType
glibType = IO GType
c_adw_animation_get_type

instance B.Types.GObject Animation

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAnimationMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveAnimationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAnimationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAnimationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAnimationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAnimationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAnimationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAnimationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAnimationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAnimationMethod "pause" o = AnimationPauseMethodInfo
    ResolveAnimationMethod "play" o = AnimationPlayMethodInfo
    ResolveAnimationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAnimationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAnimationMethod "reset" o = AnimationResetMethodInfo
    ResolveAnimationMethod "resume" o = AnimationResumeMethodInfo
    ResolveAnimationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAnimationMethod "skip" o = AnimationSkipMethodInfo
    ResolveAnimationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAnimationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAnimationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAnimationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAnimationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAnimationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAnimationMethod "getFollowEnableAnimationsSetting" o = AnimationGetFollowEnableAnimationsSettingMethodInfo
    ResolveAnimationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAnimationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAnimationMethod "getState" o = AnimationGetStateMethodInfo
    ResolveAnimationMethod "getTarget" o = AnimationGetTargetMethodInfo
    ResolveAnimationMethod "getValue" o = AnimationGetValueMethodInfo
    ResolveAnimationMethod "getWidget" o = AnimationGetWidgetMethodInfo
    ResolveAnimationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAnimationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAnimationMethod "setFollowEnableAnimationsSetting" o = AnimationSetFollowEnableAnimationsSettingMethodInfo
    ResolveAnimationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAnimationMethod "setTarget" o = AnimationSetTargetMethodInfo
    ResolveAnimationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Animation::done
-- | This signal is emitted when the animation has been completed, either on its
-- own or via calling [method/@animation@/.skip].
type AnimationDoneCallback =
    IO ()

type C_AnimationDoneCallback =
    Ptr Animation ->                        -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_AnimationDoneCallback`.
foreign import ccall "wrapper"
    mk_AnimationDoneCallback :: C_AnimationDoneCallback -> IO (FunPtr C_AnimationDoneCallback)

wrap_AnimationDoneCallback :: 
    GObject a => (a -> AnimationDoneCallback) ->
    C_AnimationDoneCallback
wrap_AnimationDoneCallback :: forall a. GObject a => (a -> IO ()) -> C_AnimationDoneCallback
wrap_AnimationDoneCallback a -> IO ()
gi'cb Ptr Animation
gi'selfPtr Ptr ()
_ = do
    Ptr Animation -> (Animation -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr Animation
gi'selfPtr ((Animation -> IO ()) -> IO ()) -> (Animation -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Animation
gi'self -> a -> IO ()
gi'cb (Animation -> a
forall a b. Coercible a b => a -> b
Coerce.coerce Animation
gi'self) 


-- | Connect a signal handler for the [done](#signal:done) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' animation #done callback
-- @
-- 
-- 
onAnimationDone :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationDoneCallback) -> m SignalHandlerId
onAnimationDone :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onAnimationDone a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationDoneCallback
wrapped' = (a -> IO ()) -> C_AnimationDoneCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationDoneCallback
wrap_AnimationDoneCallback a -> IO ()
wrapped
    FunPtr C_AnimationDoneCallback
wrapped'' <- C_AnimationDoneCallback -> IO (FunPtr C_AnimationDoneCallback)
mk_AnimationDoneCallback C_AnimationDoneCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationDoneCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"done" FunPtr C_AnimationDoneCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [done](#signal:done) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' animation #done callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterAnimationDone :: (IsAnimation a, MonadIO m) => a -> ((?self :: a) => AnimationDoneCallback) -> m SignalHandlerId
afterAnimationDone :: forall a (m :: * -> *).
(IsAnimation a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterAnimationDone a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AnimationDoneCallback
wrapped' = (a -> IO ()) -> C_AnimationDoneCallback
forall a. GObject a => (a -> IO ()) -> C_AnimationDoneCallback
wrap_AnimationDoneCallback a -> IO ()
wrapped
    FunPtr C_AnimationDoneCallback
wrapped'' <- C_AnimationDoneCallback -> IO (FunPtr C_AnimationDoneCallback)
mk_AnimationDoneCallback C_AnimationDoneCallback
wrapped'
    a
-> Text
-> FunPtr C_AnimationDoneCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"done" FunPtr C_AnimationDoneCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AnimationDoneSignalInfo
instance SignalInfo AnimationDoneSignalInfo where
    type HaskellCallbackType AnimationDoneSignalInfo = AnimationDoneCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AnimationDoneCallback cb
        cb'' <- mk_AnimationDoneCallback cb'
        connectSignalFunPtr obj "done" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Animation::done"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-Animation.html#g:signal:done"})

#endif

-- VVV Prop "follow-enable-animations-setting"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@follow-enable-animations-setting@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #followEnableAnimationsSetting
-- @
getAnimationFollowEnableAnimationsSetting :: (MonadIO m, IsAnimation o) => o -> m Bool
getAnimationFollowEnableAnimationsSetting :: forall (m :: * -> *) o. (MonadIO m, IsAnimation o) => o -> m Bool
getAnimationFollowEnableAnimationsSetting 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
"follow-enable-animations-setting"

-- | Set the value of the “@follow-enable-animations-setting@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' animation [ #followEnableAnimationsSetting 'Data.GI.Base.Attributes.:=' value ]
-- @
setAnimationFollowEnableAnimationsSetting :: (MonadIO m, IsAnimation o) => o -> Bool -> m ()
setAnimationFollowEnableAnimationsSetting :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> Bool -> m ()
setAnimationFollowEnableAnimationsSetting 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
"follow-enable-animations-setting" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@follow-enable-animations-setting@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAnimationFollowEnableAnimationsSetting :: (IsAnimation o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAnimationFollowEnableAnimationsSetting :: forall o (m :: * -> *).
(IsAnimation o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAnimationFollowEnableAnimationsSetting 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
"follow-enable-animations-setting" Bool
val

#if defined(ENABLE_OVERLOADING)
data AnimationFollowEnableAnimationsSettingPropertyInfo
instance AttrInfo AnimationFollowEnableAnimationsSettingPropertyInfo where
    type AttrAllowedOps AnimationFollowEnableAnimationsSettingPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationFollowEnableAnimationsSettingPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationFollowEnableAnimationsSettingPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AnimationFollowEnableAnimationsSettingPropertyInfo = (~) Bool
    type AttrTransferType AnimationFollowEnableAnimationsSettingPropertyInfo = Bool
    type AttrGetType AnimationFollowEnableAnimationsSettingPropertyInfo = Bool
    type AttrLabel AnimationFollowEnableAnimationsSettingPropertyInfo = "follow-enable-animations-setting"
    type AttrOrigin AnimationFollowEnableAnimationsSettingPropertyInfo = Animation
    attrGet = getAnimationFollowEnableAnimationsSetting
    attrSet = setAnimationFollowEnableAnimationsSetting
    attrTransfer _ v = do
        return v
    attrConstruct = constructAnimationFollowEnableAnimationsSetting
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Animation.followEnableAnimationsSetting"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-Animation.html#g:attr:followEnableAnimationsSetting"
        })
#endif

-- VVV Prop "state"
   -- Type: TInterface (Name {namespace = "Adw", name = "AnimationState"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data AnimationStatePropertyInfo
instance AttrInfo AnimationStatePropertyInfo where
    type AttrAllowedOps AnimationStatePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint AnimationStatePropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationStatePropertyInfo = (~) ()
    type AttrTransferTypeConstraint AnimationStatePropertyInfo = (~) ()
    type AttrTransferType AnimationStatePropertyInfo = ()
    type AttrGetType AnimationStatePropertyInfo = Adw.Enums.AnimationState
    type AttrLabel AnimationStatePropertyInfo = "state"
    type AttrOrigin AnimationStatePropertyInfo = Animation
    attrGet = getAnimationState
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Animation.state"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-Animation.html#g:attr:state"
        })
#endif

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

-- | Get the value of the “@target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #target
-- @
getAnimationTarget :: (MonadIO m, IsAnimation o) => o -> m Adw.AnimationTarget.AnimationTarget
getAnimationTarget :: forall (m :: * -> *) o.
(MonadIO m, IsAnimation o) =>
o -> m AnimationTarget
getAnimationTarget o
obj = IO AnimationTarget -> m AnimationTarget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AnimationTarget -> m AnimationTarget)
-> IO AnimationTarget -> m AnimationTarget
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe AnimationTarget) -> IO AnimationTarget
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAnimationTarget" (IO (Maybe AnimationTarget) -> IO AnimationTarget)
-> IO (Maybe AnimationTarget) -> IO AnimationTarget
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr AnimationTarget -> AnimationTarget)
-> IO (Maybe AnimationTarget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"target" ManagedPtr AnimationTarget -> AnimationTarget
Adw.AnimationTarget.AnimationTarget

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

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

#if defined(ENABLE_OVERLOADING)
data AnimationTargetPropertyInfo
instance AttrInfo AnimationTargetPropertyInfo where
    type AttrAllowedOps AnimationTargetPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AnimationTargetPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationTargetPropertyInfo = Adw.AnimationTarget.IsAnimationTarget
    type AttrTransferTypeConstraint AnimationTargetPropertyInfo = Adw.AnimationTarget.IsAnimationTarget
    type AttrTransferType AnimationTargetPropertyInfo = Adw.AnimationTarget.AnimationTarget
    type AttrGetType AnimationTargetPropertyInfo = Adw.AnimationTarget.AnimationTarget
    type AttrLabel AnimationTargetPropertyInfo = "target"
    type AttrOrigin AnimationTargetPropertyInfo = Animation
    attrGet = getAnimationTarget
    attrSet = setAnimationTarget
    attrTransfer _ v = do
        unsafeCastTo Adw.AnimationTarget.AnimationTarget v
    attrConstruct = constructAnimationTarget
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Animation.target"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-Animation.html#g:attr:target"
        })
#endif

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

-- | Get the value of the “@value@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #value
-- @
getAnimationValue :: (MonadIO m, IsAnimation o) => o -> m Double
getAnimationValue :: forall (m :: * -> *) o. (MonadIO m, IsAnimation o) => o -> m Double
getAnimationValue 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"

#if defined(ENABLE_OVERLOADING)
data AnimationValuePropertyInfo
instance AttrInfo AnimationValuePropertyInfo where
    type AttrAllowedOps AnimationValuePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint AnimationValuePropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationValuePropertyInfo = (~) ()
    type AttrTransferTypeConstraint AnimationValuePropertyInfo = (~) ()
    type AttrTransferType AnimationValuePropertyInfo = ()
    type AttrGetType AnimationValuePropertyInfo = Double
    type AttrLabel AnimationValuePropertyInfo = "value"
    type AttrOrigin AnimationValuePropertyInfo = Animation
    attrGet = getAnimationValue
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Animation.value"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-Animation.html#g:attr:value"
        })
#endif

-- VVV Prop "widget"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Widget"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@widget@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' animation #widget
-- @
getAnimationWidget :: (MonadIO m, IsAnimation o) => o -> m Gtk.Widget.Widget
getAnimationWidget :: forall (m :: * -> *) o. (MonadIO m, IsAnimation o) => o -> m Widget
getAnimationWidget o
obj = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Widget) -> IO Widget
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAnimationWidget" (IO (Maybe Widget) -> IO Widget) -> IO (Maybe Widget) -> IO Widget
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Widget -> Widget) -> IO (Maybe Widget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"widget" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

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

#if defined(ENABLE_OVERLOADING)
data AnimationWidgetPropertyInfo
instance AttrInfo AnimationWidgetPropertyInfo where
    type AttrAllowedOps AnimationWidgetPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AnimationWidgetPropertyInfo = IsAnimation
    type AttrSetTypeConstraint AnimationWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint AnimationWidgetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType AnimationWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType AnimationWidgetPropertyInfo = Gtk.Widget.Widget
    type AttrLabel AnimationWidgetPropertyInfo = "widget"
    type AttrOrigin AnimationWidgetPropertyInfo = Animation
    attrGet = getAnimationWidget
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructAnimationWidget
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Animation.widget"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.6/docs/GI-Adw-Objects-Animation.html#g:attr:widget"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Animation
type instance O.AttributeList Animation = AnimationAttributeList
type AnimationAttributeList = ('[ '("followEnableAnimationsSetting", AnimationFollowEnableAnimationsSettingPropertyInfo), '("state", AnimationStatePropertyInfo), '("target", AnimationTargetPropertyInfo), '("value", AnimationValuePropertyInfo), '("widget", AnimationWidgetPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
animationFollowEnableAnimationsSetting :: AttrLabelProxy "followEnableAnimationsSetting"
animationFollowEnableAnimationsSetting = AttrLabelProxy

animationState :: AttrLabelProxy "state"
animationState = AttrLabelProxy

animationTarget :: AttrLabelProxy "target"
animationTarget = AttrLabelProxy

animationValue :: AttrLabelProxy "value"
animationValue = AttrLabelProxy

animationWidget :: AttrLabelProxy "widget"
animationWidget = AttrLabelProxy

#endif

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

#endif

-- method Animation::get_follow_enable_animations_setting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an 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_animation_get_follow_enable_animations_setting" adw_animation_get_follow_enable_animations_setting :: 
    Ptr Animation ->                        -- self : TInterface (Name {namespace = "Adw", name = "Animation"})
    IO CInt

-- | Gets whether /@self@/ should be skipped when animations are globally disabled.
-- 
-- /Since: 1.3/
animationGetFollowEnableAnimationsSetting ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m Bool
    -- ^ __Returns:__ whether to follow the global setting
animationGetFollowEnableAnimationsSetting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Bool
animationGetFollowEnableAnimationsSetting 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Animation -> IO CInt
adw_animation_get_follow_enable_animations_setting Ptr Animation
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 AnimationGetFollowEnableAnimationsSettingMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetFollowEnableAnimationsSettingMethodInfo a signature where
    overloadedMethod = animationGetFollowEnableAnimationsSetting

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


#endif

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

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

-- | Gets the current value of /@self@/.
-- 
-- The state indicates whether /@self@/ is currently playing, paused, finished or
-- hasn\'t been started yet.
animationGetState ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m Adw.Enums.AnimationState
    -- ^ __Returns:__ the animation value
animationGetState :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m AnimationState
animationGetState a
self = IO AnimationState -> m AnimationState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnimationState -> m AnimationState)
-> IO AnimationState -> m AnimationState
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Animation -> IO CUInt
adw_animation_get_state Ptr Animation
self'
    let result' :: AnimationState
result' = (Int -> AnimationState
forall a. Enum a => Int -> a
toEnum (Int -> AnimationState)
-> (CUInt -> Int) -> CUInt -> AnimationState
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
    AnimationState -> IO AnimationState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnimationState
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetStateMethodInfo
instance (signature ~ (m Adw.Enums.AnimationState), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetStateMethodInfo a signature where
    overloadedMethod = animationGetState

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


#endif

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

foreign import ccall "adw_animation_get_target" adw_animation_get_target :: 
    Ptr Animation ->                        -- self : TInterface (Name {namespace = "Adw", name = "Animation"})
    IO (Ptr Adw.AnimationTarget.AnimationTarget)

-- | Gets the target /@self@/ animates.
animationGetTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m Adw.AnimationTarget.AnimationTarget
    -- ^ __Returns:__ the animation target
animationGetTarget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m AnimationTarget
animationGetTarget a
self = IO AnimationTarget -> m AnimationTarget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AnimationTarget -> m AnimationTarget)
-> IO AnimationTarget -> m AnimationTarget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AnimationTarget
result <- Ptr Animation -> IO (Ptr AnimationTarget)
adw_animation_get_target Ptr Animation
self'
    Text -> Ptr AnimationTarget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationGetTarget" Ptr AnimationTarget
result
    AnimationTarget
result' <- ((ManagedPtr AnimationTarget -> AnimationTarget)
-> Ptr AnimationTarget -> IO AnimationTarget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr AnimationTarget -> AnimationTarget
Adw.AnimationTarget.AnimationTarget) Ptr AnimationTarget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    AnimationTarget -> IO AnimationTarget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AnimationTarget
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetTargetMethodInfo
instance (signature ~ (m Adw.AnimationTarget.AnimationTarget), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetTargetMethodInfo a signature where
    overloadedMethod = animationGetTarget

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


#endif

-- method Animation::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an 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_animation_get_value" adw_animation_get_value :: 
    Ptr Animation ->                        -- self : TInterface (Name {namespace = "Adw", name = "Animation"})
    IO CDouble

-- | Gets the current value of /@self@/.
animationGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m Double
    -- ^ __Returns:__ the current value
animationGetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Double
animationGetValue 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr Animation -> IO CDouble
adw_animation_get_value Ptr Animation
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 AnimationGetValueMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetValueMethodInfo a signature where
    overloadedMethod = animationGetValue

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


#endif

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

foreign import ccall "adw_animation_get_widget" adw_animation_get_widget :: 
    Ptr Animation ->                        -- self : TInterface (Name {namespace = "Adw", name = "Animation"})
    IO (Ptr Gtk.Widget.Widget)

-- | Gets the widget /@self@/ was created for.
-- 
-- It provides the frame clock for the animation. It\'s not strictly necessary
-- for this widget to be same as the one being animated.
-- 
-- The widget must be mapped in order for the animation to work. If it\'s not
-- mapped, or if it gets unmapped during an ongoing animation, the animation
-- will be automatically skipped.
animationGetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m Gtk.Widget.Widget
    -- ^ __Returns:__ the animation widget
animationGetWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m Widget
animationGetWidget a
self = IO Widget -> m Widget
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
    Ptr Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Animation -> IO (Ptr Widget)
adw_animation_get_widget Ptr Animation
self'
    Text -> Ptr Widget -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"animationGetWidget" Ptr Widget
result
    Widget
result' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result'

#if defined(ENABLE_OVERLOADING)
data AnimationGetWidgetMethodInfo
instance (signature ~ (m Gtk.Widget.Widget), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationGetWidgetMethodInfo a signature where
    overloadedMethod = animationGetWidget

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


#endif

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

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

-- | Pauses a playing animation for /@self@/.
-- 
-- Does nothing if the current state of /@self@/ isn\'t @ADW_ANIMATION_PLAYING@.
-- 
-- Sets [property/@animation@/:state] to @ADW_ANIMATION_PAUSED@.
animationPause ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m ()
animationPause :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationPause a
self = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Animation -> IO ()
adw_animation_pause Ptr Animation
self'
    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 AnimationPauseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationPauseMethodInfo a signature where
    overloadedMethod = animationPause

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


#endif

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

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

-- | Starts the animation for /@self@/.
-- 
-- If the animation is playing, paused or has been completed, restarts it from
-- the beginning. This allows to easily play an animation regardless of whether
-- it\'s already playing or not.
-- 
-- Sets [property/@animation@/:state] to @ADW_ANIMATION_PLAYING@.
-- 
-- The animation will be automatically skipped if [property/@animation@/:widget] is
-- unmapped, or if [Settings:gtkEnableAnimations]("GI.Gtk.Objects.Settings#g:attr:gtkEnableAnimations") is @FALSE@.
-- 
-- As such, it\'s not guaranteed that the animation will actually run. For
-- example, when using 'GI.GLib.Functions.idleAdd' and starting an animation
-- immediately afterwards, it\'s entirely possible that the idle callback will
-- run after the animation has already finished, and not while it\'s playing.
animationPlay ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m ()
animationPlay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationPlay a
self = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Animation -> IO ()
adw_animation_play Ptr Animation
self'
    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 AnimationPlayMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationPlayMethodInfo a signature where
    overloadedMethod = animationPlay

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


#endif

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

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

-- | Resets the animation for /@self@/.
-- 
-- Sets [property/@animation@/:state] to @ADW_ANIMATION_IDLE@.
animationReset ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m ()
animationReset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationReset a
self = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Animation -> IO ()
adw_animation_reset Ptr Animation
self'
    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 AnimationResetMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationResetMethodInfo a signature where
    overloadedMethod = animationReset

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


#endif

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

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

-- | Resumes a paused animation for /@self@/.
-- 
-- This function must only be used if the animation has been paused with
-- [method/@animation@/.pause].
-- 
-- Sets [property/@animation@/:state] to @ADW_ANIMATION_PLAYING@.
animationResume ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m ()
animationResume :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationResume a
self = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Animation -> IO ()
adw_animation_resume Ptr Animation
self'
    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 AnimationResumeMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationResumeMethodInfo a signature where
    overloadedMethod = animationResume

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


#endif

-- method Animation::set_follow_enable_animations_setting
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an animation" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "setting"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to follow the global setting"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether to skip /@self@/ when animations are globally disabled.
-- 
-- The default behavior is to skip the animation. Set to @FALSE@ to disable this
-- behavior.
-- 
-- This can be useful for cases where animation is essential, like spinners, or
-- in demo applications. Most other animations should keep it enabled.
-- 
-- See [Settings:gtkEnableAnimations]("GI.Gtk.Objects.Settings#g:attr:gtkEnableAnimations").
-- 
-- /Since: 1.3/
animationSetFollowEnableAnimationsSetting ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> Bool
    -- ^ /@setting@/: whether to follow the global setting
    -> m ()
animationSetFollowEnableAnimationsSetting :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> Bool -> m ()
animationSetFollowEnableAnimationsSetting a
self Bool
setting = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let setting' :: CInt
setting' = (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
setting
    Ptr Animation -> CInt -> IO ()
adw_animation_set_follow_enable_animations_setting Ptr Animation
self' CInt
setting'
    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 AnimationSetFollowEnableAnimationsSettingMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationSetFollowEnableAnimationsSettingMethodInfo a signature where
    overloadedMethod = animationSetFollowEnableAnimationsSetting

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


#endif

-- method Animation::set_target
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "Animation" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an 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 "an animation target"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_animation_set_target" adw_animation_set_target :: 
    Ptr Animation ->                        -- self : TInterface (Name {namespace = "Adw", name = "Animation"})
    Ptr Adw.AnimationTarget.AnimationTarget -> -- target : TInterface (Name {namespace = "Adw", name = "AnimationTarget"})
    IO ()

-- | Sets the target /@self@/ animates to /@target@/.
animationSetTarget ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a, Adw.AnimationTarget.IsAnimationTarget b) =>
    a
    -- ^ /@self@/: an animation
    -> b
    -- ^ /@target@/: an animation target
    -> m ()
animationSetTarget :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAnimation a, IsAnimationTarget b) =>
a -> b -> m ()
animationSetTarget a
self b
target = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AnimationTarget
target' <- b -> IO (Ptr AnimationTarget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
target
    Ptr Animation -> Ptr AnimationTarget -> IO ()
adw_animation_set_target Ptr Animation
self' Ptr AnimationTarget
target'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
target
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AnimationSetTargetMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAnimation a, Adw.AnimationTarget.IsAnimationTarget b) => O.OverloadedMethod AnimationSetTargetMethodInfo a signature where
    overloadedMethod = animationSetTarget

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


#endif

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

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

-- | Skips the animation for /@self@/.
-- 
-- If the animation hasn\'t been started yet, is playing, or is paused, instantly
-- skips the animation to the end and causes [signal/@animation@/[done](#g:signal:done)] to be
-- emitted.
-- 
-- Sets [property/@animation@/:state] to @ADW_ANIMATION_FINISHED@.
animationSkip ::
    (B.CallStack.HasCallStack, MonadIO m, IsAnimation a) =>
    a
    -- ^ /@self@/: an animation
    -> m ()
animationSkip :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAnimation a) =>
a -> m ()
animationSkip a
self = 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 Animation
self' <- a -> IO (Ptr Animation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Animation -> IO ()
adw_animation_skip Ptr Animation
self'
    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 AnimationSkipMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAnimation a) => O.OverloadedMethod AnimationSkipMethodInfo a signature where
    overloadedMethod = animationSkip

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


#endif