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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- @GtkAdjustment@ is a model for a numeric value.
-- 
-- The @GtkAdjustment has an associated lower and upper bound.
-- It also contains step and page increments, and a page size.
-- 
-- Adjustments are used within several GTK widgets, including
-- [class\@Gtk.SpinButton], [class\@Gtk.Viewport], [class\@Gtk.Scrollbar]
-- and [class\@Gtk.Scale].
-- 
-- The @GtkAdjustment@ object does not update the value itself. Instead
-- it is left up to the owner of the @GtkAdjustment\` to control the value.

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

module GI.Gtk.Objects.Adjustment
    ( 

-- * Exported types
    Adjustment(..)                          ,
    IsAdjustment                            ,
    toAdjustment                            ,


 -- * 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"), [clampPage]("GI.Gtk.Objects.Adjustment#g:method:clampPage"), [configure]("GI.Gtk.Objects.Adjustment#g:method:configure"), [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"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getLower]("GI.Gtk.Objects.Adjustment#g:method:getLower"), [getMinimumIncrement]("GI.Gtk.Objects.Adjustment#g:method:getMinimumIncrement"), [getPageIncrement]("GI.Gtk.Objects.Adjustment#g:method:getPageIncrement"), [getPageSize]("GI.Gtk.Objects.Adjustment#g:method:getPageSize"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getStepIncrement]("GI.Gtk.Objects.Adjustment#g:method:getStepIncrement"), [getUpper]("GI.Gtk.Objects.Adjustment#g:method:getUpper"), [getValue]("GI.Gtk.Objects.Adjustment#g:method:getValue").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setLower]("GI.Gtk.Objects.Adjustment#g:method:setLower"), [setPageIncrement]("GI.Gtk.Objects.Adjustment#g:method:setPageIncrement"), [setPageSize]("GI.Gtk.Objects.Adjustment#g:method:setPageSize"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setStepIncrement]("GI.Gtk.Objects.Adjustment#g:method:setStepIncrement"), [setUpper]("GI.Gtk.Objects.Adjustment#g:method:setUpper"), [setValue]("GI.Gtk.Objects.Adjustment#g:method:setValue").

#if defined(ENABLE_OVERLOADING)
    ResolveAdjustmentMethod                 ,
#endif

-- ** clampPage #method:clampPage#

#if defined(ENABLE_OVERLOADING)
    AdjustmentClampPageMethodInfo           ,
#endif
    adjustmentClampPage                     ,


-- ** configure #method:configure#

#if defined(ENABLE_OVERLOADING)
    AdjustmentConfigureMethodInfo           ,
#endif
    adjustmentConfigure                     ,


-- ** getLower #method:getLower#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetLowerMethodInfo            ,
#endif
    adjustmentGetLower                      ,


-- ** getMinimumIncrement #method:getMinimumIncrement#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetMinimumIncrementMethodInfo ,
#endif
    adjustmentGetMinimumIncrement           ,


-- ** getPageIncrement #method:getPageIncrement#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetPageIncrementMethodInfo    ,
#endif
    adjustmentGetPageIncrement              ,


-- ** getPageSize #method:getPageSize#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetPageSizeMethodInfo         ,
#endif
    adjustmentGetPageSize                   ,


-- ** getStepIncrement #method:getStepIncrement#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetStepIncrementMethodInfo    ,
#endif
    adjustmentGetStepIncrement              ,


-- ** getUpper #method:getUpper#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetUpperMethodInfo            ,
#endif
    adjustmentGetUpper                      ,


-- ** getValue #method:getValue#

#if defined(ENABLE_OVERLOADING)
    AdjustmentGetValueMethodInfo            ,
#endif
    adjustmentGetValue                      ,


-- ** new #method:new#

    adjustmentNew                           ,


-- ** setLower #method:setLower#

#if defined(ENABLE_OVERLOADING)
    AdjustmentSetLowerMethodInfo            ,
#endif
    adjustmentSetLower                      ,


-- ** setPageIncrement #method:setPageIncrement#

#if defined(ENABLE_OVERLOADING)
    AdjustmentSetPageIncrementMethodInfo    ,
#endif
    adjustmentSetPageIncrement              ,


-- ** setPageSize #method:setPageSize#

#if defined(ENABLE_OVERLOADING)
    AdjustmentSetPageSizeMethodInfo         ,
#endif
    adjustmentSetPageSize                   ,


-- ** setStepIncrement #method:setStepIncrement#

#if defined(ENABLE_OVERLOADING)
    AdjustmentSetStepIncrementMethodInfo    ,
#endif
    adjustmentSetStepIncrement              ,


-- ** setUpper #method:setUpper#

#if defined(ENABLE_OVERLOADING)
    AdjustmentSetUpperMethodInfo            ,
#endif
    adjustmentSetUpper                      ,


-- ** setValue #method:setValue#

#if defined(ENABLE_OVERLOADING)
    AdjustmentSetValueMethodInfo            ,
#endif
    adjustmentSetValue                      ,




 -- * Properties


-- ** lower #attr:lower#
-- | The minimum value of the adjustment.

#if defined(ENABLE_OVERLOADING)
    AdjustmentLowerPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    adjustmentLower                         ,
#endif
    constructAdjustmentLower                ,
    getAdjustmentLower                      ,
    setAdjustmentLower                      ,


-- ** pageIncrement #attr:pageIncrement#
-- | The page increment of the adjustment.

#if defined(ENABLE_OVERLOADING)
    AdjustmentPageIncrementPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    adjustmentPageIncrement                 ,
#endif
    constructAdjustmentPageIncrement        ,
    getAdjustmentPageIncrement              ,
    setAdjustmentPageIncrement              ,


-- ** pageSize #attr:pageSize#
-- | The page size of the adjustment.
-- 
-- Note that the page-size is irrelevant and should be set to zero
-- if the adjustment is used for a simple scalar value, e.g. in a
-- @GtkSpinButton@.

#if defined(ENABLE_OVERLOADING)
    AdjustmentPageSizePropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    adjustmentPageSize                      ,
#endif
    constructAdjustmentPageSize             ,
    getAdjustmentPageSize                   ,
    setAdjustmentPageSize                   ,


-- ** stepIncrement #attr:stepIncrement#
-- | The step increment of the adjustment.

#if defined(ENABLE_OVERLOADING)
    AdjustmentStepIncrementPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    adjustmentStepIncrement                 ,
#endif
    constructAdjustmentStepIncrement        ,
    getAdjustmentStepIncrement              ,
    setAdjustmentStepIncrement              ,


-- ** upper #attr:upper#
-- | The maximum value of the adjustment.
-- 
-- Note that values will be restricted by @upper - page-size@ if the page-size
-- property is nonzero.

#if defined(ENABLE_OVERLOADING)
    AdjustmentUpperPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    adjustmentUpper                         ,
#endif
    constructAdjustmentUpper                ,
    getAdjustmentUpper                      ,
    setAdjustmentUpper                      ,


-- ** value #attr:value#
-- | The value of the adjustment.

#if defined(ENABLE_OVERLOADING)
    AdjustmentValuePropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    adjustmentValue                         ,
#endif
    constructAdjustmentValue                ,
    getAdjustmentValue                      ,
    setAdjustmentValue                      ,




 -- * Signals


-- ** changed #signal:changed#

    AdjustmentChangedCallback               ,
#if defined(ENABLE_OVERLOADING)
    AdjustmentChangedSignalInfo             ,
#endif
    afterAdjustmentChanged                  ,
    onAdjustmentChanged                     ,


-- ** valueChanged #signal:valueChanged#

    AdjustmentValueChangedCallback          ,
#if defined(ENABLE_OVERLOADING)
    AdjustmentValueChangedSignalInfo        ,
#endif
    afterAdjustmentValueChanged             ,
    onAdjustmentValueChanged                ,




    ) 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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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

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

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

foreign import ccall "gtk_adjustment_get_type"
    c_gtk_adjustment_get_type :: IO B.Types.GType

instance B.Types.TypedObject Adjustment where
    glibType :: IO GType
glibType = IO GType
c_gtk_adjustment_get_type

instance B.Types.GObject Adjustment

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAdjustmentMethod (t :: Symbol) (o :: *) :: * where
    ResolveAdjustmentMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAdjustmentMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAdjustmentMethod "clampPage" o = AdjustmentClampPageMethodInfo
    ResolveAdjustmentMethod "configure" o = AdjustmentConfigureMethodInfo
    ResolveAdjustmentMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAdjustmentMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAdjustmentMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAdjustmentMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAdjustmentMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAdjustmentMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAdjustmentMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAdjustmentMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAdjustmentMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAdjustmentMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAdjustmentMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAdjustmentMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAdjustmentMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAdjustmentMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAdjustmentMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAdjustmentMethod "getLower" o = AdjustmentGetLowerMethodInfo
    ResolveAdjustmentMethod "getMinimumIncrement" o = AdjustmentGetMinimumIncrementMethodInfo
    ResolveAdjustmentMethod "getPageIncrement" o = AdjustmentGetPageIncrementMethodInfo
    ResolveAdjustmentMethod "getPageSize" o = AdjustmentGetPageSizeMethodInfo
    ResolveAdjustmentMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAdjustmentMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAdjustmentMethod "getStepIncrement" o = AdjustmentGetStepIncrementMethodInfo
    ResolveAdjustmentMethod "getUpper" o = AdjustmentGetUpperMethodInfo
    ResolveAdjustmentMethod "getValue" o = AdjustmentGetValueMethodInfo
    ResolveAdjustmentMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAdjustmentMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAdjustmentMethod "setLower" o = AdjustmentSetLowerMethodInfo
    ResolveAdjustmentMethod "setPageIncrement" o = AdjustmentSetPageIncrementMethodInfo
    ResolveAdjustmentMethod "setPageSize" o = AdjustmentSetPageSizeMethodInfo
    ResolveAdjustmentMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAdjustmentMethod "setStepIncrement" o = AdjustmentSetStepIncrementMethodInfo
    ResolveAdjustmentMethod "setUpper" o = AdjustmentSetUpperMethodInfo
    ResolveAdjustmentMethod "setValue" o = AdjustmentSetValueMethodInfo
    ResolveAdjustmentMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Adjustment::changed
-- | Emitted when one or more of the @GtkAdjustment@ properties have been
-- changed.
-- 
-- Note that the [Adjustment:value]("GI.Gtk.Objects.Adjustment#g:attr:value") property is
-- covered by the [Adjustment::valueChanged]("GI.Gtk.Objects.Adjustment#g:signal:valueChanged") signal.
type AdjustmentChangedCallback =
    IO ()

type C_AdjustmentChangedCallback =
    Ptr Adjustment ->                       -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_AdjustmentChangedCallback :: 
    GObject a => (a -> AdjustmentChangedCallback) ->
    C_AdjustmentChangedCallback
wrap_AdjustmentChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_AdjustmentChangedCallback
wrap_AdjustmentChangedCallback a -> IO ()
gi'cb Ptr Adjustment
gi'selfPtr Ptr ()
_ = do
    Ptr Adjustment -> (Adjustment -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Adjustment
gi'selfPtr ((Adjustment -> IO ()) -> IO ()) -> (Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Adjustment
gi'self -> a -> IO ()
gi'cb (Adjustment -> a
Coerce.coerce Adjustment
gi'self) 


-- | Connect a signal handler for the [changed](#signal:changed) 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' adjustment #changed callback
-- @
-- 
-- 
onAdjustmentChanged :: (IsAdjustment a, MonadIO m) => a -> ((?self :: a) => AdjustmentChangedCallback) -> m SignalHandlerId
onAdjustmentChanged :: forall a (m :: * -> *).
(IsAdjustment a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onAdjustmentChanged a
obj (?self::a) => IO ()
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AdjustmentChangedCallback
wrapped' = (a -> IO ()) -> C_AdjustmentChangedCallback
forall a. GObject a => (a -> IO ()) -> C_AdjustmentChangedCallback
wrap_AdjustmentChangedCallback a -> IO ()
wrapped
    FunPtr C_AdjustmentChangedCallback
wrapped'' <- C_AdjustmentChangedCallback
-> IO (FunPtr C_AdjustmentChangedCallback)
mk_AdjustmentChangedCallback C_AdjustmentChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_AdjustmentChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_AdjustmentChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) 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' adjustment #changed 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.
-- 
afterAdjustmentChanged :: (IsAdjustment a, MonadIO m) => a -> ((?self :: a) => AdjustmentChangedCallback) -> m SignalHandlerId
afterAdjustmentChanged :: forall a (m :: * -> *).
(IsAdjustment a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterAdjustmentChanged a
obj (?self::a) => IO ()
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AdjustmentChangedCallback
wrapped' = (a -> IO ()) -> C_AdjustmentChangedCallback
forall a. GObject a => (a -> IO ()) -> C_AdjustmentChangedCallback
wrap_AdjustmentChangedCallback a -> IO ()
wrapped
    FunPtr C_AdjustmentChangedCallback
wrapped'' <- C_AdjustmentChangedCallback
-> IO (FunPtr C_AdjustmentChangedCallback)
mk_AdjustmentChangedCallback C_AdjustmentChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_AdjustmentChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_AdjustmentChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AdjustmentChangedSignalInfo
instance SignalInfo AdjustmentChangedSignalInfo where
    type HaskellCallbackType AdjustmentChangedSignalInfo = AdjustmentChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AdjustmentChangedCallback cb
        cb'' <- mk_AdjustmentChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment::changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:signal:changed"})

#endif

-- signal Adjustment::value-changed
-- | Emitted when the value has been changed.
type AdjustmentValueChangedCallback =
    IO ()

type C_AdjustmentValueChangedCallback =
    Ptr Adjustment ->                       -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_AdjustmentValueChangedCallback :: 
    GObject a => (a -> AdjustmentValueChangedCallback) ->
    C_AdjustmentValueChangedCallback
wrap_AdjustmentValueChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_AdjustmentChangedCallback
wrap_AdjustmentValueChangedCallback a -> IO ()
gi'cb Ptr Adjustment
gi'selfPtr Ptr ()
_ = do
    Ptr Adjustment -> (Adjustment -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Adjustment
gi'selfPtr ((Adjustment -> IO ()) -> IO ()) -> (Adjustment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Adjustment
gi'self -> a -> IO ()
gi'cb (Adjustment -> a
Coerce.coerce Adjustment
gi'self) 


-- | 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' adjustment #valueChanged callback
-- @
-- 
-- 
onAdjustmentValueChanged :: (IsAdjustment a, MonadIO m) => a -> ((?self :: a) => AdjustmentValueChangedCallback) -> m SignalHandlerId
onAdjustmentValueChanged :: forall a (m :: * -> *).
(IsAdjustment a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onAdjustmentValueChanged a
obj (?self::a) => IO ()
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AdjustmentChangedCallback
wrapped' = (a -> IO ()) -> C_AdjustmentChangedCallback
forall a. GObject a => (a -> IO ()) -> C_AdjustmentChangedCallback
wrap_AdjustmentValueChangedCallback a -> IO ()
wrapped
    FunPtr C_AdjustmentChangedCallback
wrapped'' <- C_AdjustmentChangedCallback
-> IO (FunPtr C_AdjustmentChangedCallback)
mk_AdjustmentValueChangedCallback C_AdjustmentChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_AdjustmentChangedCallback
-> 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_AdjustmentChangedCallback
wrapped'' 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' adjustment #valueChanged 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.
-- 
afterAdjustmentValueChanged :: (IsAdjustment a, MonadIO m) => a -> ((?self :: a) => AdjustmentValueChangedCallback) -> m SignalHandlerId
afterAdjustmentValueChanged :: forall a (m :: * -> *).
(IsAdjustment a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterAdjustmentValueChanged a
obj (?self::a) => IO ()
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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_AdjustmentChangedCallback
wrapped' = (a -> IO ()) -> C_AdjustmentChangedCallback
forall a. GObject a => (a -> IO ()) -> C_AdjustmentChangedCallback
wrap_AdjustmentValueChangedCallback a -> IO ()
wrapped
    FunPtr C_AdjustmentChangedCallback
wrapped'' <- C_AdjustmentChangedCallback
-> IO (FunPtr C_AdjustmentChangedCallback)
mk_AdjustmentValueChangedCallback C_AdjustmentChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_AdjustmentChangedCallback
-> 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_AdjustmentChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AdjustmentValueChangedSignalInfo
instance SignalInfo AdjustmentValueChangedSignalInfo where
    type HaskellCallbackType AdjustmentValueChangedSignalInfo = AdjustmentValueChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AdjustmentValueChangedCallback cb
        cb'' <- mk_AdjustmentValueChangedCallback cb'
        connectSignalFunPtr obj "value-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment::value-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:signal:valueChanged"})

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data AdjustmentLowerPropertyInfo
instance AttrInfo AdjustmentLowerPropertyInfo where
    type AttrAllowedOps AdjustmentLowerPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AdjustmentLowerPropertyInfo = IsAdjustment
    type AttrSetTypeConstraint AdjustmentLowerPropertyInfo = (~) Double
    type AttrTransferTypeConstraint AdjustmentLowerPropertyInfo = (~) Double
    type AttrTransferType AdjustmentLowerPropertyInfo = Double
    type AttrGetType AdjustmentLowerPropertyInfo = Double
    type AttrLabel AdjustmentLowerPropertyInfo = "lower"
    type AttrOrigin AdjustmentLowerPropertyInfo = Adjustment
    attrGet = getAdjustmentLower
    attrSet = setAdjustmentLower
    attrTransfer _ v = do
        return v
    attrConstruct = constructAdjustmentLower
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.lower"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:attr:lower"
        })
#endif

-- VVV Prop "page-increment"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@page-increment@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' adjustment [ #pageIncrement 'Data.GI.Base.Attributes.:=' value ]
-- @
setAdjustmentPageIncrement :: (MonadIO m, IsAdjustment o) => o -> Double -> m ()
setAdjustmentPageIncrement :: forall (m :: * -> *) o.
(MonadIO m, IsAdjustment o) =>
o -> Double -> m ()
setAdjustmentPageIncrement o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"page-increment" Double
val

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

#if defined(ENABLE_OVERLOADING)
data AdjustmentPageIncrementPropertyInfo
instance AttrInfo AdjustmentPageIncrementPropertyInfo where
    type AttrAllowedOps AdjustmentPageIncrementPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AdjustmentPageIncrementPropertyInfo = IsAdjustment
    type AttrSetTypeConstraint AdjustmentPageIncrementPropertyInfo = (~) Double
    type AttrTransferTypeConstraint AdjustmentPageIncrementPropertyInfo = (~) Double
    type AttrTransferType AdjustmentPageIncrementPropertyInfo = Double
    type AttrGetType AdjustmentPageIncrementPropertyInfo = Double
    type AttrLabel AdjustmentPageIncrementPropertyInfo = "page-increment"
    type AttrOrigin AdjustmentPageIncrementPropertyInfo = Adjustment
    attrGet = getAdjustmentPageIncrement
    attrSet = setAdjustmentPageIncrement
    attrTransfer _ v = do
        return v
    attrConstruct = constructAdjustmentPageIncrement
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.pageIncrement"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:attr:pageIncrement"
        })
#endif

-- VVV Prop "page-size"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@page-size@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' adjustment [ #pageSize 'Data.GI.Base.Attributes.:=' value ]
-- @
setAdjustmentPageSize :: (MonadIO m, IsAdjustment o) => o -> Double -> m ()
setAdjustmentPageSize :: forall (m :: * -> *) o.
(MonadIO m, IsAdjustment o) =>
o -> Double -> m ()
setAdjustmentPageSize o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"page-size" Double
val

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

#if defined(ENABLE_OVERLOADING)
data AdjustmentPageSizePropertyInfo
instance AttrInfo AdjustmentPageSizePropertyInfo where
    type AttrAllowedOps AdjustmentPageSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AdjustmentPageSizePropertyInfo = IsAdjustment
    type AttrSetTypeConstraint AdjustmentPageSizePropertyInfo = (~) Double
    type AttrTransferTypeConstraint AdjustmentPageSizePropertyInfo = (~) Double
    type AttrTransferType AdjustmentPageSizePropertyInfo = Double
    type AttrGetType AdjustmentPageSizePropertyInfo = Double
    type AttrLabel AdjustmentPageSizePropertyInfo = "page-size"
    type AttrOrigin AdjustmentPageSizePropertyInfo = Adjustment
    attrGet = getAdjustmentPageSize
    attrSet = setAdjustmentPageSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructAdjustmentPageSize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.pageSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:attr:pageSize"
        })
#endif

-- VVV Prop "step-increment"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@step-increment@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' adjustment [ #stepIncrement 'Data.GI.Base.Attributes.:=' value ]
-- @
setAdjustmentStepIncrement :: (MonadIO m, IsAdjustment o) => o -> Double -> m ()
setAdjustmentStepIncrement :: forall (m :: * -> *) o.
(MonadIO m, IsAdjustment o) =>
o -> Double -> m ()
setAdjustmentStepIncrement o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"step-increment" Double
val

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

#if defined(ENABLE_OVERLOADING)
data AdjustmentStepIncrementPropertyInfo
instance AttrInfo AdjustmentStepIncrementPropertyInfo where
    type AttrAllowedOps AdjustmentStepIncrementPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AdjustmentStepIncrementPropertyInfo = IsAdjustment
    type AttrSetTypeConstraint AdjustmentStepIncrementPropertyInfo = (~) Double
    type AttrTransferTypeConstraint AdjustmentStepIncrementPropertyInfo = (~) Double
    type AttrTransferType AdjustmentStepIncrementPropertyInfo = Double
    type AttrGetType AdjustmentStepIncrementPropertyInfo = Double
    type AttrLabel AdjustmentStepIncrementPropertyInfo = "step-increment"
    type AttrOrigin AdjustmentStepIncrementPropertyInfo = Adjustment
    attrGet = getAdjustmentStepIncrement
    attrSet = setAdjustmentStepIncrement
    attrTransfer _ v = do
        return v
    attrConstruct = constructAdjustmentStepIncrement
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.stepIncrement"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:attr:stepIncrement"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data AdjustmentUpperPropertyInfo
instance AttrInfo AdjustmentUpperPropertyInfo where
    type AttrAllowedOps AdjustmentUpperPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AdjustmentUpperPropertyInfo = IsAdjustment
    type AttrSetTypeConstraint AdjustmentUpperPropertyInfo = (~) Double
    type AttrTransferTypeConstraint AdjustmentUpperPropertyInfo = (~) Double
    type AttrTransferType AdjustmentUpperPropertyInfo = Double
    type AttrGetType AdjustmentUpperPropertyInfo = Double
    type AttrLabel AdjustmentUpperPropertyInfo = "upper"
    type AttrOrigin AdjustmentUpperPropertyInfo = Adjustment
    attrGet = getAdjustmentUpper
    attrSet = setAdjustmentUpper
    attrTransfer _ v = do
        return v
    attrConstruct = constructAdjustmentUpper
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.upper"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:attr:upper"
        })
#endif

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

-- | 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' adjustment #value
-- @
getAdjustmentValue :: (MonadIO m, IsAdjustment o) => o -> m Double
getAdjustmentValue :: forall (m :: * -> *) o.
(MonadIO m, IsAdjustment o) =>
o -> m Double
getAdjustmentValue o
obj = IO Double -> m Double
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"

-- | Set 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.set' adjustment [ #value 'Data.GI.Base.Attributes.:=' value ]
-- @
setAdjustmentValue :: (MonadIO m, IsAdjustment o) => o -> Double -> m ()
setAdjustmentValue :: forall (m :: * -> *) o.
(MonadIO m, IsAdjustment o) =>
o -> Double -> m ()
setAdjustmentValue o
obj Double
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"value" Double
val

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

#if defined(ENABLE_OVERLOADING)
data AdjustmentValuePropertyInfo
instance AttrInfo AdjustmentValuePropertyInfo where
    type AttrAllowedOps AdjustmentValuePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AdjustmentValuePropertyInfo = IsAdjustment
    type AttrSetTypeConstraint AdjustmentValuePropertyInfo = (~) Double
    type AttrTransferTypeConstraint AdjustmentValuePropertyInfo = (~) Double
    type AttrTransferType AdjustmentValuePropertyInfo = Double
    type AttrGetType AdjustmentValuePropertyInfo = Double
    type AttrLabel AdjustmentValuePropertyInfo = "value"
    type AttrOrigin AdjustmentValuePropertyInfo = Adjustment
    attrGet = getAdjustmentValue
    attrSet = setAdjustmentValue
    attrTransfer _ v = do
        return v
    attrConstruct = constructAdjustmentValue
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.value"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#g:attr:value"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Adjustment
type instance O.AttributeList Adjustment = AdjustmentAttributeList
type AdjustmentAttributeList = ('[ '("lower", AdjustmentLowerPropertyInfo), '("pageIncrement", AdjustmentPageIncrementPropertyInfo), '("pageSize", AdjustmentPageSizePropertyInfo), '("stepIncrement", AdjustmentStepIncrementPropertyInfo), '("upper", AdjustmentUpperPropertyInfo), '("value", AdjustmentValuePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
adjustmentLower :: AttrLabelProxy "lower"
adjustmentLower = AttrLabelProxy

adjustmentPageIncrement :: AttrLabelProxy "pageIncrement"
adjustmentPageIncrement = AttrLabelProxy

adjustmentPageSize :: AttrLabelProxy "pageSize"
adjustmentPageSize = AttrLabelProxy

adjustmentStepIncrement :: AttrLabelProxy "stepIncrement"
adjustmentStepIncrement = AttrLabelProxy

adjustmentUpper :: AttrLabelProxy "upper"
adjustmentUpper = AttrLabelProxy

adjustmentValue :: AttrLabelProxy "value"
adjustmentValue = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Adjustment = AdjustmentSignalList
type AdjustmentSignalList = ('[ '("changed", AdjustmentChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("valueChanged", AdjustmentValueChangedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Adjustment::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the initial value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lower"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the minimum value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "upper"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "step_increment"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the step increment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_increment"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the page increment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_size"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the page size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Adjustment" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_new" gtk_adjustment_new :: 
    CDouble ->                              -- value : TBasicType TDouble
    CDouble ->                              -- lower : TBasicType TDouble
    CDouble ->                              -- upper : TBasicType TDouble
    CDouble ->                              -- step_increment : TBasicType TDouble
    CDouble ->                              -- page_increment : TBasicType TDouble
    CDouble ->                              -- page_size : TBasicType TDouble
    IO (Ptr Adjustment)

-- | Creates a new @GtkAdjustment@.
adjustmentNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Double
    -- ^ /@value@/: the initial value
    -> Double
    -- ^ /@lower@/: the minimum value
    -> Double
    -- ^ /@upper@/: the maximum value
    -> Double
    -- ^ /@stepIncrement@/: the step increment
    -> Double
    -- ^ /@pageIncrement@/: the page increment
    -> Double
    -- ^ /@pageSize@/: the page size
    -> m Adjustment
    -- ^ __Returns:__ a new @GtkAdjustment@
adjustmentNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Double
-> Double -> Double -> Double -> Double -> Double -> m Adjustment
adjustmentNew Double
value Double
lower Double
upper Double
stepIncrement Double
pageIncrement Double
pageSize = IO Adjustment -> m Adjustment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Adjustment -> m Adjustment) -> IO Adjustment -> m Adjustment
forall a b. (a -> b) -> a -> b
$ do
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    let lower' :: CDouble
lower' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lower
    let upper' :: CDouble
upper' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
upper
    let stepIncrement' :: CDouble
stepIncrement' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
stepIncrement
    let pageIncrement' :: CDouble
pageIncrement' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageIncrement
    let pageSize' :: CDouble
pageSize' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageSize
    Ptr Adjustment
result <- CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO (Ptr Adjustment)
gtk_adjustment_new CDouble
value' CDouble
lower' CDouble
upper' CDouble
stepIncrement' CDouble
pageIncrement' CDouble
pageSize'
    Text -> Ptr Adjustment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"adjustmentNew" Ptr Adjustment
result
    Adjustment
result' <- ((ManagedPtr Adjustment -> Adjustment)
-> Ptr Adjustment -> IO Adjustment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Adjustment -> Adjustment
Adjustment) Ptr Adjustment
result
    Adjustment -> IO Adjustment
forall (m :: * -> *) a. Monad m => a -> m a
return Adjustment
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Adjustment::clamp_page
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lower"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the lower value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "upper"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the upper value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_clamp_page" gtk_adjustment_clamp_page :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- lower : TBasicType TDouble
    CDouble ->                              -- upper : TBasicType TDouble
    IO ()

-- | Updates the value property to ensure that the range
-- between /@lower@/ and /@upper@/ is in the current page.
-- 
-- The current page goes from @value@ to @value@ + @page-size@.
-- If the range is larger than the page size, then only the
-- start of it will be in the current page.
-- 
-- A [Adjustment::valueChanged]("GI.Gtk.Objects.Adjustment#g:signal:valueChanged") signal will be emitted
-- if the value is changed.
adjustmentClampPage ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@lower@/: the lower value
    -> Double
    -- ^ /@upper@/: the upper value
    -> m ()
adjustmentClampPage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> Double -> m ()
adjustmentClampPage a
adjustment Double
lower Double
upper = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let lower' :: CDouble
lower' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lower
    let upper' :: CDouble
upper' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
upper
    Ptr Adjustment -> CDouble -> CDouble -> IO ()
gtk_adjustment_clamp_page Ptr Adjustment
adjustment' CDouble
lower' CDouble
upper'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentClampPageMethodInfo
instance (signature ~ (Double -> Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentClampPageMethodInfo a signature where
    overloadedMethod = adjustmentClampPage

instance O.OverloadedMethodInfo AdjustmentClampPageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentClampPage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentClampPage"
        })


#endif

-- method Adjustment::configure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lower"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new minimum value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "upper"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new maximum value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "step_increment"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new step increment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_increment"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new page increment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_size"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new page size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_configure" gtk_adjustment_configure :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- value : TBasicType TDouble
    CDouble ->                              -- lower : TBasicType TDouble
    CDouble ->                              -- upper : TBasicType TDouble
    CDouble ->                              -- step_increment : TBasicType TDouble
    CDouble ->                              -- page_increment : TBasicType TDouble
    CDouble ->                              -- page_size : TBasicType TDouble
    IO ()

-- | Sets all properties of the adjustment at once.
-- 
-- Use this function to avoid multiple emissions of the
-- [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed") signal. See
-- 'GI.Gtk.Objects.Adjustment.adjustmentSetLower' for an alternative
-- way of compressing multiple emissions of
-- [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed") into one.
adjustmentConfigure ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@value@/: the new value
    -> Double
    -- ^ /@lower@/: the new minimum value
    -> Double
    -- ^ /@upper@/: the new maximum value
    -> Double
    -- ^ /@stepIncrement@/: the new step increment
    -> Double
    -- ^ /@pageIncrement@/: the new page increment
    -> Double
    -- ^ /@pageSize@/: the new page size
    -> m ()
adjustmentConfigure :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a
-> Double -> Double -> Double -> Double -> Double -> Double -> m ()
adjustmentConfigure a
adjustment Double
value Double
lower Double
upper Double
stepIncrement Double
pageIncrement Double
pageSize = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    let lower' :: CDouble
lower' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lower
    let upper' :: CDouble
upper' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
upper
    let stepIncrement' :: CDouble
stepIncrement' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
stepIncrement
    let pageIncrement' :: CDouble
pageIncrement' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageIncrement
    let pageSize' :: CDouble
pageSize' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageSize
    Ptr Adjustment
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> CDouble
-> IO ()
gtk_adjustment_configure Ptr Adjustment
adjustment' CDouble
value' CDouble
lower' CDouble
upper' CDouble
stepIncrement' CDouble
pageIncrement' CDouble
pageSize'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentConfigureMethodInfo
instance (signature ~ (Double -> Double -> Double -> Double -> Double -> Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentConfigureMethodInfo a signature where
    overloadedMethod = adjustmentConfigure

instance O.OverloadedMethodInfo AdjustmentConfigureMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentConfigure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentConfigure"
        })


#endif

-- method Adjustment::get_lower
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_lower" gtk_adjustment_get_lower :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Retrieves the minimum value of the adjustment.
adjustmentGetLower ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ The current minimum value of the adjustment
adjustmentGetLower :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetLower a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_lower Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetLowerMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetLowerMethodInfo a signature where
    overloadedMethod = adjustmentGetLower

instance O.OverloadedMethodInfo AdjustmentGetLowerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetLower",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetLower"
        })


#endif

-- method Adjustment::get_minimum_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_minimum_increment" gtk_adjustment_get_minimum_increment :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Gets the smaller of step increment and page increment.
adjustmentGetMinimumIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ the minimum increment of /@adjustment@/
adjustmentGetMinimumIncrement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetMinimumIncrement a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_minimum_increment Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetMinimumIncrementMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetMinimumIncrementMethodInfo a signature where
    overloadedMethod = adjustmentGetMinimumIncrement

instance O.OverloadedMethodInfo AdjustmentGetMinimumIncrementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetMinimumIncrement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetMinimumIncrement"
        })


#endif

-- method Adjustment::get_page_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_page_increment" gtk_adjustment_get_page_increment :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Retrieves the page increment of the adjustment.
adjustmentGetPageIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ The current page increment of the adjustment
adjustmentGetPageIncrement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetPageIncrement a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_page_increment Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetPageIncrementMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetPageIncrementMethodInfo a signature where
    overloadedMethod = adjustmentGetPageIncrement

instance O.OverloadedMethodInfo AdjustmentGetPageIncrementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetPageIncrement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetPageIncrement"
        })


#endif

-- method Adjustment::get_page_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_page_size" gtk_adjustment_get_page_size :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Retrieves the page size of the adjustment.
adjustmentGetPageSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ The current page size of the adjustment
adjustmentGetPageSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetPageSize a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_page_size Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetPageSizeMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetPageSizeMethodInfo a signature where
    overloadedMethod = adjustmentGetPageSize

instance O.OverloadedMethodInfo AdjustmentGetPageSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetPageSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetPageSize"
        })


#endif

-- method Adjustment::get_step_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_step_increment" gtk_adjustment_get_step_increment :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Retrieves the step increment of the adjustment.
adjustmentGetStepIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ The current step increment of the adjustment.
adjustmentGetStepIncrement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetStepIncrement a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_step_increment Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetStepIncrementMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetStepIncrementMethodInfo a signature where
    overloadedMethod = adjustmentGetStepIncrement

instance O.OverloadedMethodInfo AdjustmentGetStepIncrementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetStepIncrement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetStepIncrement"
        })


#endif

-- method Adjustment::get_upper
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_upper" gtk_adjustment_get_upper :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Retrieves the maximum value of the adjustment.
adjustmentGetUpper ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ The current maximum value of the adjustment
adjustmentGetUpper :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetUpper a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_upper Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetUpperMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetUpperMethodInfo a signature where
    overloadedMethod = adjustmentGetUpper

instance O.OverloadedMethodInfo AdjustmentGetUpperMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetUpper",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetUpper"
        })


#endif

-- method Adjustment::get_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , 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 "gtk_adjustment_get_value" gtk_adjustment_get_value :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    IO CDouble

-- | Gets the current value of the adjustment.
adjustmentGetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> m Double
    -- ^ __Returns:__ The current value of the adjustment
adjustmentGetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> m Double
adjustmentGetValue a
adjustment = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    CDouble
result <- Ptr Adjustment -> IO CDouble
gtk_adjustment_get_value Ptr Adjustment
adjustment'
    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
adjustment
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data AdjustmentGetValueMethodInfo
instance (signature ~ (m Double), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentGetValueMethodInfo a signature where
    overloadedMethod = adjustmentGetValue

instance O.OverloadedMethodInfo AdjustmentGetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentGetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentGetValue"
        })


#endif

-- method Adjustment::set_lower
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "lower"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new minimum value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_set_lower" gtk_adjustment_set_lower :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- lower : TBasicType TDouble
    IO ()

-- | Sets the minimum value of the adjustment.
-- 
-- When setting multiple adjustment properties via their individual
-- setters, multiple [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed") signals will
-- be emitted. However, since the emission of the
-- [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed") signal is tied to the emission
-- of the [notify](#g:signal:notify) signals of the changed properties, it’s possible
-- to compress the [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed") signals into one
-- by calling 'GI.GObject.Objects.Object.objectFreezeNotify' and 'GI.GObject.Objects.Object.objectThawNotify'
-- around the calls to the individual setters.
-- 
-- Alternatively, using a single @/g_object_set()/@ for all the properties
-- to change, or using 'GI.Gtk.Objects.Adjustment.adjustmentConfigure' has the same effect.
adjustmentSetLower ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@lower@/: the new minimum value
    -> m ()
adjustmentSetLower :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> m ()
adjustmentSetLower a
adjustment Double
lower = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let lower' :: CDouble
lower' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lower
    Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_lower Ptr Adjustment
adjustment' CDouble
lower'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentSetLowerMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentSetLowerMethodInfo a signature where
    overloadedMethod = adjustmentSetLower

instance O.OverloadedMethodInfo AdjustmentSetLowerMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentSetLower",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentSetLower"
        })


#endif

-- method Adjustment::set_page_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_increment"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new page increment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_set_page_increment" gtk_adjustment_set_page_increment :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- page_increment : TBasicType TDouble
    IO ()

-- | Sets the page increment of the adjustment.
-- 
-- See 'GI.Gtk.Objects.Adjustment.adjustmentSetLower' about how to compress
-- multiple emissions of the [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed")
-- signal when setting multiple adjustment properties.
adjustmentSetPageIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@pageIncrement@/: the new page increment
    -> m ()
adjustmentSetPageIncrement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> m ()
adjustmentSetPageIncrement a
adjustment Double
pageIncrement = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let pageIncrement' :: CDouble
pageIncrement' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageIncrement
    Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_page_increment Ptr Adjustment
adjustment' CDouble
pageIncrement'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentSetPageIncrementMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentSetPageIncrementMethodInfo a signature where
    overloadedMethod = adjustmentSetPageIncrement

instance O.OverloadedMethodInfo AdjustmentSetPageIncrementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentSetPageIncrement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentSetPageIncrement"
        })


#endif

-- method Adjustment::set_page_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_size"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new page size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_set_page_size" gtk_adjustment_set_page_size :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- page_size : TBasicType TDouble
    IO ()

-- | Sets the page size of the adjustment.
-- 
-- See 'GI.Gtk.Objects.Adjustment.adjustmentSetLower' about how to compress
-- multiple emissions of the [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed")
-- signal when setting multiple adjustment properties.
adjustmentSetPageSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@pageSize@/: the new page size
    -> m ()
adjustmentSetPageSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> m ()
adjustmentSetPageSize a
adjustment Double
pageSize = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let pageSize' :: CDouble
pageSize' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pageSize
    Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_page_size Ptr Adjustment
adjustment' CDouble
pageSize'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentSetPageSizeMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentSetPageSizeMethodInfo a signature where
    overloadedMethod = adjustmentSetPageSize

instance O.OverloadedMethodInfo AdjustmentSetPageSizeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentSetPageSize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentSetPageSize"
        })


#endif

-- method Adjustment::set_step_increment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "step_increment"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new step increment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_set_step_increment" gtk_adjustment_set_step_increment :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- step_increment : TBasicType TDouble
    IO ()

-- | Sets the step increment of the adjustment.
-- 
-- See 'GI.Gtk.Objects.Adjustment.adjustmentSetLower' about how to compress
-- multiple emissions of the [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed")
-- signal when setting multiple adjustment properties.
adjustmentSetStepIncrement ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@stepIncrement@/: the new step increment
    -> m ()
adjustmentSetStepIncrement :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> m ()
adjustmentSetStepIncrement a
adjustment Double
stepIncrement = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let stepIncrement' :: CDouble
stepIncrement' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
stepIncrement
    Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_step_increment Ptr Adjustment
adjustment' CDouble
stepIncrement'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentSetStepIncrementMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentSetStepIncrementMethodInfo a signature where
    overloadedMethod = adjustmentSetStepIncrement

instance O.OverloadedMethodInfo AdjustmentSetStepIncrementMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentSetStepIncrement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentSetStepIncrement"
        })


#endif

-- method Adjustment::set_upper
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "upper"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new maximum value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_set_upper" gtk_adjustment_set_upper :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- upper : TBasicType TDouble
    IO ()

-- | Sets the maximum value of the adjustment.
-- 
-- Note that values will be restricted by @upper - page-size@
-- if the page-size property is nonzero.
-- 
-- See 'GI.Gtk.Objects.Adjustment.adjustmentSetLower' about how to compress
-- multiple emissions of the [Adjustment::changed]("GI.Gtk.Objects.Adjustment#g:signal:changed")
-- signal when setting multiple adjustment properties.
adjustmentSetUpper ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@upper@/: the new maximum value
    -> m ()
adjustmentSetUpper :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> m ()
adjustmentSetUpper a
adjustment Double
upper = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let upper' :: CDouble
upper' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
upper
    Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_upper Ptr Adjustment
adjustment' CDouble
upper'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentSetUpperMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentSetUpperMethodInfo a signature where
    overloadedMethod = adjustmentSetUpper

instance O.OverloadedMethodInfo AdjustmentSetUpperMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentSetUpper",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentSetUpper"
        })


#endif

-- method Adjustment::set_value
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "adjustment"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "Adjustment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkAdjustment`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_adjustment_set_value" gtk_adjustment_set_value :: 
    Ptr Adjustment ->                       -- adjustment : TInterface (Name {namespace = "Gtk", name = "Adjustment"})
    CDouble ->                              -- value : TBasicType TDouble
    IO ()

-- | Sets the @GtkAdjustment@ value.
-- 
-- The value is clamped to lie between [Adjustment:lower]("GI.Gtk.Objects.Adjustment#g:attr:lower")
-- and [Adjustment:upper]("GI.Gtk.Objects.Adjustment#g:attr:upper").
-- 
-- Note that for adjustments which are used in a @GtkScrollbar@,
-- the effective range of allowed values goes from
-- [Adjustment:lower]("GI.Gtk.Objects.Adjustment#g:attr:lower") to
-- [Adjustment:upper]("GI.Gtk.Objects.Adjustment#g:attr:upper") - [Adjustment:pageSize]("GI.Gtk.Objects.Adjustment#g:attr:pageSize").
adjustmentSetValue ::
    (B.CallStack.HasCallStack, MonadIO m, IsAdjustment a) =>
    a
    -- ^ /@adjustment@/: a @GtkAdjustment@
    -> Double
    -- ^ /@value@/: the new value
    -> m ()
adjustmentSetValue :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAdjustment a) =>
a -> Double -> m ()
adjustmentSetValue a
adjustment Double
value = 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 Adjustment
adjustment' <- a -> IO (Ptr Adjustment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
adjustment
    let value' :: CDouble
value' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
value
    Ptr Adjustment -> CDouble -> IO ()
gtk_adjustment_set_value Ptr Adjustment
adjustment' CDouble
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
adjustment
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AdjustmentSetValueMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsAdjustment a) => O.OverloadedMethod AdjustmentSetValueMethodInfo a signature where
    overloadedMethod = adjustmentSetValue

instance O.OverloadedMethodInfo AdjustmentSetValueMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.Adjustment.adjustmentSetValue",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.5/docs/GI-Gtk-Objects-Adjustment.html#v:adjustmentSetValue"
        })


#endif