{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Atk.Interfaces.Value.Value' should be implemented for components which either display
-- a value from a bounded range, or which allow the user to specify a
-- value from a bounded range, or both. For instance, most sliders and
-- range controls, as well as dials, should have t'GI.Atk.Objects.Object.Object'
-- representations which implement t'GI.Atk.Interfaces.Value.Value' on the component\'s
-- behalf. @/AtKValues/@ may be read-only, in which case attempts to
-- alter the value return would fail.
-- 
-- \<refsect1 id=\"current-value-text\">
-- \<title>On the subject of current value text\<\/title>
-- \<para>
-- In addition to providing the current value, implementors can
-- optionally provide an end-user-consumable textual description
-- associated with this value. This description should be included
-- when the numeric value fails to convey the full, on-screen
-- representation seen by users.
-- \<\/para>
-- 
-- \<example>
-- \<title>Password strength\<\/title>
-- A password strength meter whose value changes as the user types
-- their new password. Red is used for values less than 4.0, yellow
-- for values between 4.0 and 7.0, and green for values greater than
-- 7.0. In this instance, value text should be provided by the
-- implementor. Appropriate value text would be \"weak\", \"acceptable,\"
-- and \"strong\" respectively.
-- \<\/example>
-- 
-- A level bar whose value changes to reflect the battery charge. The
-- color remains the same regardless of the charge and there is no
-- on-screen text reflecting the fullness of the battery. In this
-- case, because the position within the bar is the only indication
-- the user has of the current charge, value text should not be
-- provided by the implementor.
-- 
-- \<refsect2 id=\"implementor-notes\">
-- \<title>Implementor Notes\<\/title>
-- \<para>
-- Implementors should bear in mind that assistive technologies will
-- likely prefer the value text provided over the numeric value when
-- presenting a widget\'s value. As a result, strings not intended for
-- end users should not be exposed in the value text, and strings
-- which are exposed should be localized. In the case of widgets which
-- display value text on screen, for instance through a separate label
-- in close proximity to the value-displaying widget, it is still
-- expected that implementors will expose the value text using the
-- above API.
-- \<\/para>
-- 
-- \<para>
-- t'GI.Atk.Interfaces.Value.Value' should NOT be implemented for widgets whose displayed
-- value is not reflective of a meaningful amount. For instance, a
-- progress pulse indicator whose value alternates between 0.0 and 1.0
-- to indicate that some process is still taking place should not
-- implement t'GI.Atk.Interfaces.Value.Value' because the current value does not reflect
-- progress towards completion.
-- \<\/para>
-- \<\/refsect2>
-- \<\/refsect1>
-- 
-- \<refsect1 id=\"ranges\">
-- \<title>On the subject of ranges\<\/title>
-- \<para>
-- In addition to providing the minimum and maximum values,
-- implementors can optionally provide details about subranges
-- associated with the widget. These details should be provided by the
-- implementor when both of the following are communicated visually to
-- the end user:
-- \<\/para>
-- \<itemizedlist>
--   \<listitem>The existence of distinct ranges such as \"weak\",
--   \"acceptable\", and \"strong\" indicated by color, bar tick marks,
--   and\/or on-screen text.\<\/listitem>
--   \<listitem>Where the current value stands within a given subrange,
--   for instance illustrating progression from very \"weak\" towards
--   nearly \"acceptable\" through changes in shade and\/or position on
--   the bar within the \"weak\" subrange.\<\/listitem>
-- \<\/itemizedlist>
-- \<para>
-- If both of the above do not apply to the widget, it should be
-- sufficient to expose the numeric value, along with the value text
-- if appropriate, to make the widget accessible.
-- \<\/para>
-- 
-- \<refsect2 id=\"ranges-implementor-notes\">
-- \<title>Implementor Notes\<\/title>
-- \<para>
-- If providing subrange details is deemed necessary, all possible
-- values of the widget are expected to fall within one of the
-- subranges defined by the implementor.
-- \<\/para>
-- \<\/refsect2>
-- \<\/refsect1>
-- 
-- \<refsect1 id=\"localization\">
-- \<title>On the subject of localization of end-user-consumable text
-- values\<\/title>
-- \<para>
-- Because value text and subrange descriptors are human-consumable,
-- implementors are expected to provide localized strings which can be
-- directly presented to end users via their assistive technology. In
-- order to simplify this for implementors, implementors can use
-- 'GI.Atk.Functions.valueTypeGetLocalizedName' with the following
-- already-localized constants for commonly-needed values can be used:
-- \<\/para>
-- 
-- \<itemizedlist>
--   \<listitem>ATK_VALUE_VERY_WEAK\<\/listitem>
--   \<listitem>ATK_VALUE_WEAK\<\/listitem>
--   \<listitem>ATK_VALUE_ACCEPTABLE\<\/listitem>
--   \<listitem>ATK_VALUE_STRONG\<\/listitem>
--   \<listitem>ATK_VALUE_VERY_STRONG\<\/listitem>
--   \<listitem>ATK_VALUE_VERY_LOW\<\/listitem>
--   \<listitem>ATK_VALUE_LOW\<\/listitem>
--   \<listitem>ATK_VALUE_MEDIUM\<\/listitem>
--   \<listitem>ATK_VALUE_HIGH\<\/listitem>
--   \<listitem>ATK_VALUE_VERY_HIGH\<\/listitem>
--   \<listitem>ATK_VALUE_VERY_BAD\<\/listitem>
--   \<listitem>ATK_VALUE_BAD\<\/listitem>
--   \<listitem>ATK_VALUE_GOOD\<\/listitem>
--   \<listitem>ATK_VALUE_VERY_GOOD\<\/listitem>
--   \<listitem>ATK_VALUE_BEST\<\/listitem>
--   \<listitem>ATK_VALUE_SUBSUBOPTIMAL\<\/listitem>
--   \<listitem>ATK_VALUE_SUBOPTIMAL\<\/listitem>
--   \<listitem>ATK_VALUE_OPTIMAL\<\/listitem>
-- \<\/itemizedlist>
-- \<para>
-- Proposals for additional constants, along with their use cases,
-- should be submitted to the GNOME Accessibility Team.
-- \<\/para>
-- \<\/refsect1>
-- 
-- \<refsect1 id=\"changes\">
-- \<title>On the subject of changes\<\/title>
-- \<para>
-- Note that if there is a textual description associated with the new
-- numeric value, that description should be included regardless of
-- whether or not it has also changed.
-- \<\/para>
-- \<\/refsect1>

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

module GI.Atk.Interfaces.Value
    ( 

-- * Exported types
    Value(..)                               ,
    IsValue                                 ,
    toValue                                 ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveValueMethod                      ,
#endif


-- ** getCurrentValue #method:getCurrentValue#

#if defined(ENABLE_OVERLOADING)
    ValueGetCurrentValueMethodInfo          ,
#endif
    valueGetCurrentValue                    ,


-- ** getIncrement #method:getIncrement#

#if defined(ENABLE_OVERLOADING)
    ValueGetIncrementMethodInfo             ,
#endif
    valueGetIncrement                       ,


-- ** getMaximumValue #method:getMaximumValue#

#if defined(ENABLE_OVERLOADING)
    ValueGetMaximumValueMethodInfo          ,
#endif
    valueGetMaximumValue                    ,


-- ** getMinimumIncrement #method:getMinimumIncrement#

#if defined(ENABLE_OVERLOADING)
    ValueGetMinimumIncrementMethodInfo      ,
#endif
    valueGetMinimumIncrement                ,


-- ** getMinimumValue #method:getMinimumValue#

#if defined(ENABLE_OVERLOADING)
    ValueGetMinimumValueMethodInfo          ,
#endif
    valueGetMinimumValue                    ,


-- ** getRange #method:getRange#

#if defined(ENABLE_OVERLOADING)
    ValueGetRangeMethodInfo                 ,
#endif
    valueGetRange                           ,


-- ** getSubRanges #method:getSubRanges#

#if defined(ENABLE_OVERLOADING)
    ValueGetSubRangesMethodInfo             ,
#endif
    valueGetSubRanges                       ,


-- ** getValueAndText #method:getValueAndText#

#if defined(ENABLE_OVERLOADING)
    ValueGetValueAndTextMethodInfo          ,
#endif
    valueGetValueAndText                    ,


-- ** setCurrentValue #method:setCurrentValue#

#if defined(ENABLE_OVERLOADING)
    ValueSetCurrentValueMethodInfo          ,
#endif
    valueSetCurrentValue                    ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    ValueSetValueMethodInfo                 ,
#endif
    valueSetValue                           ,




 -- * Signals
-- ** valueChanged #signal:valueChanged#

    C_ValueValueChangedCallback             ,
    ValueValueChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    ValueValueChangedSignalInfo             ,
#endif
    afterValueValueChanged                  ,
    genClosure_ValueValueChanged            ,
    mk_ValueValueChangedCallback            ,
    noValueValueChangedCallback             ,
    onValueValueChanged                     ,
    wrap_ValueValueChangedCallback          ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Atk.Structs.Range as Atk.Range
import qualified GI.GObject.Objects.Object as GObject.Object

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

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

foreign import ccall "atk_value_get_type"
    c_atk_value_get_type :: IO B.Types.GType

instance B.Types.TypedObject Value where
    glibType :: IO GType
glibType = IO GType
c_atk_value_get_type

instance B.Types.GObject Value

-- | Convert 'Value' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Value where
    toGValue :: Value -> IO GValue
toGValue Value
o = do
        GType
gtype <- IO GType
c_atk_value_get_type
        Value -> (Ptr Value -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Value
o (GType -> (GValue -> Ptr Value -> IO ()) -> Ptr Value -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Value -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Value
fromGValue GValue
gv = do
        Ptr Value
ptr <- GValue -> IO (Ptr Value)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Value)
        (ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Value -> Value
Value Ptr Value
ptr
        
    

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveValueMethod (t :: Symbol) (o :: *) :: * where
    ResolveValueMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveValueMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveValueMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveValueMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveValueMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveValueMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveValueMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveValueMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveValueMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveValueMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveValueMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveValueMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveValueMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveValueMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveValueMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveValueMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveValueMethod "getCurrentValue" o = ValueGetCurrentValueMethodInfo
    ResolveValueMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveValueMethod "getIncrement" o = ValueGetIncrementMethodInfo
    ResolveValueMethod "getMaximumValue" o = ValueGetMaximumValueMethodInfo
    ResolveValueMethod "getMinimumIncrement" o = ValueGetMinimumIncrementMethodInfo
    ResolveValueMethod "getMinimumValue" o = ValueGetMinimumValueMethodInfo
    ResolveValueMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveValueMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveValueMethod "getRange" o = ValueGetRangeMethodInfo
    ResolveValueMethod "getSubRanges" o = ValueGetSubRangesMethodInfo
    ResolveValueMethod "getValueAndText" o = ValueGetValueAndTextMethodInfo
    ResolveValueMethod "setCurrentValue" o = ValueSetCurrentValueMethodInfo
    ResolveValueMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveValueMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveValueMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveValueMethod "setValue" o = ValueSetValueMethodInfo
    ResolveValueMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveValueMethod t Value, O.MethodInfo info Value p) => OL.IsLabel t (Value -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

-- method Value::get_current_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue representing the current accessible value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_current_value" atk_value_get_current_value :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED valueGetCurrentValue ["Since 2.12. Use 'GI.Atk.Interfaces.Value.valueGetValueAndText'","instead."] #-}
-- | Gets the value of this object.
valueGetCurrentValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m (GValue)
valueGetCurrentValue :: a -> m GValue
valueGetCurrentValue a
obj = IO GValue -> m GValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Value -> Ptr GValue -> IO ()
atk_value_get_current_value Ptr Value
obj' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data ValueGetCurrentValueMethodInfo
instance (signature ~ (m (GValue)), MonadIO m, IsValue a) => O.MethodInfo ValueGetCurrentValueMethodInfo a signature where
    overloadedMethod = valueGetCurrentValue

#endif

-- method Value::get_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , 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 "atk_value_get_increment" atk_value_get_increment :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    IO CDouble

-- | Gets the minimum increment by which the value of this object may be
-- changed.  If zero, the minimum increment is undefined, which may
-- mean that it is limited only by the floating point precision of the
-- platform.
-- 
-- /Since: 2.12/
valueGetIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m Double
    -- ^ __Returns:__ the minimum increment by which the value of this
    -- object may be changed. zero if undefined.
valueGetIncrement :: a -> m Double
valueGetIncrement a
obj = IO Double -> m Double
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 Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    CDouble
result <- Ptr Value -> IO CDouble
atk_value_get_increment Ptr Value
obj'
    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
obj
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ValueGetIncrementMethodInfo
instance (signature ~ (m Double), MonadIO m, IsValue a) => O.MethodInfo ValueGetIncrementMethodInfo a signature where
    overloadedMethod = valueGetIncrement

#endif

-- method Value::get_maximum_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue representing the maximum accessible value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_maximum_value" atk_value_get_maximum_value :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED valueGetMaximumValue ["Since 2.12. Use 'GI.Atk.Interfaces.Value.valueGetRange' instead."] #-}
-- | Gets the maximum value of this object.
valueGetMaximumValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m (GValue)
valueGetMaximumValue :: a -> m GValue
valueGetMaximumValue a
obj = IO GValue -> m GValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Value -> Ptr GValue -> IO ()
atk_value_get_maximum_value Ptr Value
obj' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data ValueGetMaximumValueMethodInfo
instance (signature ~ (m (GValue)), MonadIO m, IsValue a) => O.MethodInfo ValueGetMaximumValueMethodInfo a signature where
    overloadedMethod = valueGetMaximumValue

#endif

-- method Value::get_minimum_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a #GValue representing the minimum increment by which the accessible value may be changed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_minimum_increment" atk_value_get_minimum_increment :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED valueGetMinimumIncrement ["Since 2.12. Use 'GI.Atk.Interfaces.Value.valueGetIncrement' instead."] #-}
-- | Gets the minimum increment by which the value of this object may be changed.  If zero,
-- the minimum increment is undefined, which may mean that it is limited only by the
-- floating point precision of the platform.
-- 
-- /Since: 1.12/
valueGetMinimumIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m (GValue)
valueGetMinimumIncrement :: a -> m GValue
valueGetMinimumIncrement a
obj = IO GValue -> m GValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Value -> Ptr GValue -> IO ()
atk_value_get_minimum_increment Ptr Value
obj' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data ValueGetMinimumIncrementMethodInfo
instance (signature ~ (m (GValue)), MonadIO m, IsValue a) => O.MethodInfo ValueGetMinimumIncrementMethodInfo a signature where
    overloadedMethod = valueGetMinimumIncrement

#endif

-- method Value::get_minimum_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue representing the minimum accessible value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_minimum_value" atk_value_get_minimum_value :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    Ptr GValue ->                           -- value : TGValue
    IO ()

{-# DEPRECATED valueGetMinimumValue ["Since 2.12. Use 'GI.Atk.Interfaces.Value.valueGetRange' instead."] #-}
-- | Gets the minimum value of this object.
valueGetMinimumValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m (GValue)
valueGetMinimumValue :: a -> m GValue
valueGetMinimumValue a
obj = IO GValue -> m GValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GValue -> m GValue) -> IO GValue -> m GValue
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr GValue
value <- Int -> IO (Ptr GValue)
forall a. Int -> IO (Ptr a)
SP.callocBytes Int
24 :: IO (Ptr GValue)
    Ptr Value -> Ptr GValue -> IO ()
atk_value_get_minimum_value Ptr Value
obj' Ptr GValue
value
    GValue
value' <- Ptr GValue -> IO GValue
B.GValue.wrapGValuePtr Ptr GValue
value
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    GValue -> IO GValue
forall (m :: * -> *) a. Monad m => a -> m a
return GValue
value'

#if defined(ENABLE_OVERLOADING)
data ValueGetMinimumValueMethodInfo
instance (signature ~ (m (GValue)), MonadIO m, IsValue a) => O.MethodInfo ValueGetMinimumValueMethodInfo a signature where
    overloadedMethod = valueGetMinimumValue

#endif

-- method Value::get_range
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Atk" , name = "Range" })
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_range" atk_value_get_range :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    IO (Ptr Atk.Range.Range)

-- | Gets the range of this object.
-- 
-- /Since: 2.12/
valueGetRange ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m (Maybe Atk.Range.Range)
    -- ^ __Returns:__ a newly allocated t'GI.Atk.Structs.Range.Range'
    -- that represents the minimum, maximum and descriptor (if available)
    -- of /@obj@/. NULL if that range is not defined.
valueGetRange :: a -> m (Maybe Range)
valueGetRange a
obj = IO (Maybe Range) -> m (Maybe Range)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Range) -> m (Maybe Range))
-> IO (Maybe Range) -> m (Maybe Range)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr Range
result <- Ptr Value -> IO (Ptr Range)
atk_value_get_range Ptr Value
obj'
    Maybe Range
maybeResult <- Ptr Range -> (Ptr Range -> IO Range) -> IO (Maybe Range)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Range
result ((Ptr Range -> IO Range) -> IO (Maybe Range))
-> (Ptr Range -> IO Range) -> IO (Maybe Range)
forall a b. (a -> b) -> a -> b
$ \Ptr Range
result' -> do
        Range
result'' <- ((ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Range -> Range
Atk.Range.Range) Ptr Range
result'
        Range -> IO Range
forall (m :: * -> *) a. Monad m => a -> m a
return Range
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    Maybe Range -> IO (Maybe Range)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Range
maybeResult

#if defined(ENABLE_OVERLOADING)
data ValueGetRangeMethodInfo
instance (signature ~ (m (Maybe Atk.Range.Range)), MonadIO m, IsValue a) => O.MethodInfo ValueGetRangeMethodInfo a signature where
    overloadedMethod = valueGetRange

#endif

-- method Value::get_sub_ranges
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGSList (TInterface Name { namespace = "Atk" , name = "Range" }))
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_sub_ranges" atk_value_get_sub_ranges :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    IO (Ptr (GSList (Ptr Atk.Range.Range)))

-- | Gets the list of subranges defined for this object. See t'GI.Atk.Interfaces.Value.Value'
-- introduction for examples of subranges and when to expose them.
-- 
-- /Since: 2.12/
valueGetSubRanges ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m [Atk.Range.Range]
    -- ^ __Returns:__ an t'GI.GLib.Structs.SList.SList' of
    -- t'GI.Atk.Structs.Range.Range' which each of the subranges defined for this object. Free
    -- the returns list with @/g_slist_free()/@.
valueGetSubRanges :: a -> m [Range]
valueGetSubRanges a
obj = IO [Range] -> m [Range]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Range] -> m [Range]) -> IO [Range] -> m [Range]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr (GSList (Ptr Range))
result <- Ptr Value -> IO (Ptr (GSList (Ptr Range)))
atk_value_get_sub_ranges Ptr Value
obj'
    [Ptr Range]
result' <- Ptr (GSList (Ptr Range)) -> IO [Ptr Range]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList (Ptr Range))
result
    [Range]
result'' <- (Ptr Range -> IO Range) -> [Ptr Range] -> IO [Range]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Range -> Range) -> Ptr Range -> IO Range
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Range -> Range
Atk.Range.Range) [Ptr Range]
result'
    Ptr (GSList (Ptr Range)) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList (Ptr Range))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    [Range] -> IO [Range]
forall (m :: * -> *) a. Monad m => a -> m a
return [Range]
result''

#if defined(ENABLE_OVERLOADING)
data ValueGetSubRangesMethodInfo
instance (signature ~ (m [Atk.Range.Range]), MonadIO m, IsValue a) => O.MethodInfo ValueGetSubRangesMethodInfo a signature where
    overloadedMethod = valueGetSubRanges

#endif

-- method Value::get_value_and_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "address of #gdouble to put the current value of @obj"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "address of #gchar to put the human\nreadable text alternative for @value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_get_value_and_text" atk_value_get_value_and_text :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    Ptr CDouble ->                          -- value : TBasicType TDouble
    Ptr CString ->                          -- text : TBasicType TUTF8
    IO ()

-- | Gets the current value and the human readable text alternative of
-- /@obj@/. /@text@/ is a newly created string, that must be freed by the
-- caller. Can be NULL if no descriptor is available.
-- 
-- /Since: 2.12/
valueGetValueAndText ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> m ((Double, T.Text))
valueGetValueAndText :: a -> m (Double, Text)
valueGetValueAndText a
obj = IO (Double, Text) -> m (Double, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Double, Text) -> m (Double, Text))
-> IO (Double, Text) -> m (Double, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr CDouble
value <- IO (Ptr CDouble)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CDouble)
    Ptr CString
text <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Value -> Ptr CDouble -> Ptr CString -> IO ()
atk_value_get_value_and_text Ptr Value
obj' Ptr CDouble
value Ptr CString
text
    CDouble
value' <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
value
    let value'' :: Double
value'' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value'
    CString
text' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
text
    Text
text'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    Ptr CDouble -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CDouble
value
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
text
    (Double, Text) -> IO (Double, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
value'', Text
text'')

#if defined(ENABLE_OVERLOADING)
data ValueGetValueAndTextMethodInfo
instance (signature ~ (m ((Double, T.Text))), MonadIO m, IsValue a) => O.MethodInfo ValueGetValueAndTextMethodInfo a signature where
    overloadedMethod = valueGetValueAndText

#endif

-- method Value::set_current_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TGValue
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GValue which is the desired new accessible value."
--                 , 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 "atk_value_set_current_value" atk_value_set_current_value :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    Ptr GValue ->                           -- value : TGValue
    IO CInt

{-# DEPRECATED valueSetCurrentValue ["Since 2.12. Use 'GI.Atk.Interfaces.Value.valueSetValue' instead."] #-}
-- | Sets the value of this object.
valueSetCurrentValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> GValue
    -- ^ /@value@/: a t'GI.GObject.Structs.Value.Value' which is the desired new accessible value.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if new value is successfully set, 'P.False' otherwise.
valueSetCurrentValue :: a -> GValue -> m Bool
valueSetCurrentValue a
obj GValue
value = IO Bool -> m Bool
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 Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    Ptr GValue
value' <- GValue -> IO (Ptr GValue)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GValue
value
    CInt
result <- Ptr Value -> Ptr GValue -> IO CInt
atk_value_set_current_value Ptr Value
obj' Ptr GValue
value'
    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
obj
    GValue -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GValue
value
    Ptr GValue -> IO ()
B.GValue.unsetGValue Ptr GValue
value'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ValueSetCurrentValueMethodInfo
instance (signature ~ (GValue -> m Bool), MonadIO m, IsValue a) => O.MethodInfo ValueSetCurrentValueMethodInfo a signature where
    overloadedMethod = valueSetCurrentValue

#endif

-- method Value::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "obj"
--           , argType = TInterface Name { namespace = "Atk" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GObject instance that implements AtkValueIface"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a double which is the desired new accessible value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "atk_value_set_value" atk_value_set_value :: 
    Ptr Value ->                            -- obj : TInterface (Name {namespace = "Atk", name = "Value"})
    CDouble ->                              -- new_value : TBasicType TDouble
    IO ()

-- | Sets the value of this object.
-- 
-- This method is intended to provide a way to change the value of the
-- object. In any case, it is possible that the value can\'t be
-- modified (ie: a read-only component). If the value changes due this
-- call, it is possible that the text could change, and will trigger
-- an [valueChanged]("GI.Atk.Interfaces.Value#g:signal:valueChanged") signal emission.
-- 
-- Note for implementors: the deprecated 'GI.Atk.Interfaces.Value.valueSetCurrentValue'
-- method returned TRUE or FALSE depending if the value was assigned
-- or not. In the practice several implementors were not able to
-- decide it, and returned TRUE in any case. For that reason it is not
-- required anymore to return if the value was properly assigned or
-- not.
-- 
-- /Since: 2.12/
valueSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsValue a) =>
    a
    -- ^ /@obj@/: a GObject instance that implements AtkValueIface
    -> Double
    -- ^ /@newValue@/: a double which is the desired new accessible value.
    -> m ()
valueSetValue :: a -> Double -> m ()
valueSetValue a
obj Double
newValue = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
obj' <- a -> IO (Ptr Value)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
obj
    let newValue' :: CDouble
newValue' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
newValue
    Ptr Value -> CDouble -> IO ()
atk_value_set_value Ptr Value
obj' CDouble
newValue'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
obj
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ValueSetValueMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsValue a) => O.MethodInfo ValueSetValueMethodInfo a signature where
    overloadedMethod = valueSetValue

#endif

-- signal Value::value-changed
-- | The \'value-changed\' signal is emitted when the current value
-- that represent the object changes. /@value@/ is the numerical
-- representation of this new value.  /@text@/ is the human
-- readable text alternative of /@value@/, and can be NULL if it is
-- not available. Note that if there is a textual description
-- associated with the new numeric value, that description
-- should be included regardless of whether or not it has also
-- changed.
-- 
-- Example: a password meter whose value changes as the user
-- types their new password. Appropiate value text would be
-- \"weak\", \"acceptable\" and \"strong\".
-- 
-- /Since: 2.12/
type ValueValueChangedCallback =
    Double
    -- ^ /@value@/: the new value in a numerical form.
    -> T.Text
    -- ^ /@text@/: human readable text alternative (also called
    -- description) of this object. NULL if not available.
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `ValueValueChangedCallback`@.
noValueValueChangedCallback :: Maybe ValueValueChangedCallback
noValueValueChangedCallback :: Maybe ValueValueChangedCallback
noValueValueChangedCallback = Maybe ValueValueChangedCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_ValueValueChangedCallback =
    Ptr () ->                               -- object
    CDouble ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_ValueValueChanged :: MonadIO m => ValueValueChangedCallback -> m (GClosure C_ValueValueChangedCallback)
genClosure_ValueValueChanged :: ValueValueChangedCallback
-> m (GClosure C_ValueValueChangedCallback)
genClosure_ValueValueChanged ValueValueChangedCallback
cb = IO (GClosure C_ValueValueChangedCallback)
-> m (GClosure C_ValueValueChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_ValueValueChangedCallback)
 -> m (GClosure C_ValueValueChangedCallback))
-> IO (GClosure C_ValueValueChangedCallback)
-> m (GClosure C_ValueValueChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_ValueValueChangedCallback
cb' = ValueValueChangedCallback -> C_ValueValueChangedCallback
wrap_ValueValueChangedCallback ValueValueChangedCallback
cb
    C_ValueValueChangedCallback
-> IO (FunPtr C_ValueValueChangedCallback)
mk_ValueValueChangedCallback C_ValueValueChangedCallback
cb' IO (FunPtr C_ValueValueChangedCallback)
-> (FunPtr C_ValueValueChangedCallback
    -> IO (GClosure C_ValueValueChangedCallback))
-> IO (GClosure C_ValueValueChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_ValueValueChangedCallback
-> IO (GClosure C_ValueValueChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `ValueValueChangedCallback` into a `C_ValueValueChangedCallback`.
wrap_ValueValueChangedCallback ::
    ValueValueChangedCallback ->
    C_ValueValueChangedCallback
wrap_ValueValueChangedCallback :: ValueValueChangedCallback -> C_ValueValueChangedCallback
wrap_ValueValueChangedCallback ValueValueChangedCallback
_cb Ptr ()
_ CDouble
value CString
text Ptr ()
_ = do
    let value' :: Double
value' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
value
    Text
text' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text
    ValueValueChangedCallback
_cb  Double
value' Text
text'


-- | Connect a signal handler for the [valueChanged](#signal:valueChanged) 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' value #valueChanged callback
-- @
-- 
-- 
onValueValueChanged :: (IsValue a, MonadIO m) => a -> ValueValueChangedCallback -> m SignalHandlerId
onValueValueChanged :: a -> ValueValueChangedCallback -> m SignalHandlerId
onValueValueChanged a
obj ValueValueChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ValueValueChangedCallback
cb' = ValueValueChangedCallback -> C_ValueValueChangedCallback
wrap_ValueValueChangedCallback ValueValueChangedCallback
cb
    FunPtr C_ValueValueChangedCallback
cb'' <- C_ValueValueChangedCallback
-> IO (FunPtr C_ValueValueChangedCallback)
mk_ValueValueChangedCallback C_ValueValueChangedCallback
cb'
    a
-> Text
-> FunPtr C_ValueValueChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"value-changed" FunPtr C_ValueValueChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [valueChanged](#signal:valueChanged) 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' value #valueChanged callback
-- @
-- 
-- 
afterValueValueChanged :: (IsValue a, MonadIO m) => a -> ValueValueChangedCallback -> m SignalHandlerId
afterValueValueChanged :: a -> ValueValueChangedCallback -> m SignalHandlerId
afterValueValueChanged a
obj ValueValueChangedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_ValueValueChangedCallback
cb' = ValueValueChangedCallback -> C_ValueValueChangedCallback
wrap_ValueValueChangedCallback ValueValueChangedCallback
cb
    FunPtr C_ValueValueChangedCallback
cb'' <- C_ValueValueChangedCallback
-> IO (FunPtr C_ValueValueChangedCallback)
mk_ValueValueChangedCallback C_ValueValueChangedCallback
cb'
    a
-> Text
-> FunPtr C_ValueValueChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"value-changed" FunPtr C_ValueValueChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data ValueValueChangedSignalInfo
instance SignalInfo ValueValueChangedSignalInfo where
    type HaskellCallbackType ValueValueChangedSignalInfo = ValueValueChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_ValueValueChangedCallback cb
        cb'' <- mk_ValueValueChangedCallback cb'
        connectSignalFunPtr obj "value-changed" cb'' connectMode detail

#endif

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

#endif