{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A layout manager constraining its children to a given size.
-- 
-- \<picture>
--   \<source srcset=\"clamp-wide-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"clamp-wide.png\" alt=\"clamp-wide\">
-- \<\/picture>
-- \<picture>
--   \<source srcset=\"clamp-narrow-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"clamp-narrow.png\" alt=\"clamp-narrow\">
-- \<\/picture>
-- 
-- @AdwClampLayout@ constraints the size of the widgets it contains to a given
-- maximum size. It will constrain the width if it is horizontal, or the height
-- if it is vertical. The expansion of the children from their minimum to their
-- maximum size is eased out for a smooth transition.
-- 
-- If a child requires more than the requested maximum size, it will be
-- allocated the minimum size it can fit in instead.
-- 
-- Each child will get the style  classes .large when it reached its maximum
-- size, .small when it\'s allocated the full size, .medium in-between, or none
-- if it hasn\'t been allocated yet.

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

module GI.Adw.Objects.ClampLayout
    ( 

-- * Exported types
    ClampLayout(..)                         ,
    IsClampLayout                           ,
    toClampLayout                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [allocate]("GI.Gtk.Objects.LayoutManager#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [layoutChanged]("GI.Gtk.Objects.LayoutManager#g:method:layoutChanged"), [measure]("GI.Gtk.Objects.LayoutManager#g:method:measure"), [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"), [getLayoutChild]("GI.Gtk.Objects.LayoutManager#g:method:getLayoutChild"), [getMaximumSize]("GI.Adw.Objects.ClampLayout#g:method:getMaximumSize"), [getOrientation]("GI.Gtk.Interfaces.Orientable#g:method:getOrientation"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRequestMode]("GI.Gtk.Objects.LayoutManager#g:method:getRequestMode"), [getTighteningThreshold]("GI.Adw.Objects.ClampLayout#g:method:getTighteningThreshold"), [getWidget]("GI.Gtk.Objects.LayoutManager#g:method:getWidget").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setMaximumSize]("GI.Adw.Objects.ClampLayout#g:method:setMaximumSize"), [setOrientation]("GI.Gtk.Interfaces.Orientable#g:method:setOrientation"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTighteningThreshold]("GI.Adw.Objects.ClampLayout#g:method:setTighteningThreshold").

#if defined(ENABLE_OVERLOADING)
    ResolveClampLayoutMethod                ,
#endif

-- ** getMaximumSize #method:getMaximumSize#

#if defined(ENABLE_OVERLOADING)
    ClampLayoutGetMaximumSizeMethodInfo     ,
#endif
    clampLayoutGetMaximumSize               ,


-- ** getTighteningThreshold #method:getTighteningThreshold#

#if defined(ENABLE_OVERLOADING)
    ClampLayoutGetTighteningThresholdMethodInfo,
#endif
    clampLayoutGetTighteningThreshold       ,


-- ** new #method:new#

    clampLayoutNew                          ,


-- ** setMaximumSize #method:setMaximumSize#

#if defined(ENABLE_OVERLOADING)
    ClampLayoutSetMaximumSizeMethodInfo     ,
#endif
    clampLayoutSetMaximumSize               ,


-- ** setTighteningThreshold #method:setTighteningThreshold#

#if defined(ENABLE_OVERLOADING)
    ClampLayoutSetTighteningThresholdMethodInfo,
#endif
    clampLayoutSetTighteningThreshold       ,




 -- * Properties


-- ** maximumSize #attr:maximumSize#
-- | The maximum size to allocate to the children.
-- 
-- It is the width if the layout is horizontal, or the height if it is
-- vertical.

#if defined(ENABLE_OVERLOADING)
    ClampLayoutMaximumSizePropertyInfo      ,
#endif
#if defined(ENABLE_OVERLOADING)
    clampLayoutMaximumSize                  ,
#endif
    constructClampLayoutMaximumSize         ,
    getClampLayoutMaximumSize               ,
    setClampLayoutMaximumSize               ,


-- ** tighteningThreshold #attr:tighteningThreshold#
-- | The size above which the children are clamped.
-- 
-- Starting from this size, the layout will tighten its grip on the children,
-- slowly allocating less and less of the available size up to the maximum
-- allocated size. Below that threshold and below the maximum size, the
-- children will be allocated all the available size.
-- 
-- If the threshold is greater than the maximum size to allocate to the
-- children, they will be allocated the whole size up to the maximum. If the
-- threshold is lower than the minimum size to allocate to the children, that
-- size will be used as the tightening threshold.
-- 
-- Effectively, tightening the grip on a child before it reaches its maximum
-- size makes transitions to and from the maximum size smoother when resizing.

#if defined(ENABLE_OVERLOADING)
    ClampLayoutTighteningThresholdPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    clampLayoutTighteningThreshold          ,
#endif
    constructClampLayoutTighteningThreshold ,
    getClampLayoutTighteningThreshold       ,
    setClampLayoutTighteningThreshold       ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Interfaces.Orientable as Gtk.Orientable
import qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager

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

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

foreign import ccall "adw_clamp_layout_get_type"
    c_adw_clamp_layout_get_type :: IO B.Types.GType

instance B.Types.TypedObject ClampLayout where
    glibType :: IO GType
glibType = IO GType
c_adw_clamp_layout_get_type

instance B.Types.GObject ClampLayout

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

instance O.HasParentTypes ClampLayout
type instance O.ParentTypes ClampLayout = '[Gtk.LayoutManager.LayoutManager, GObject.Object.Object, Gtk.Orientable.Orientable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveClampLayoutMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveClampLayoutMethod "allocate" o = Gtk.LayoutManager.LayoutManagerAllocateMethodInfo
    ResolveClampLayoutMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveClampLayoutMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveClampLayoutMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveClampLayoutMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveClampLayoutMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveClampLayoutMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveClampLayoutMethod "layoutChanged" o = Gtk.LayoutManager.LayoutManagerLayoutChangedMethodInfo
    ResolveClampLayoutMethod "measure" o = Gtk.LayoutManager.LayoutManagerMeasureMethodInfo
    ResolveClampLayoutMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveClampLayoutMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveClampLayoutMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveClampLayoutMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveClampLayoutMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveClampLayoutMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveClampLayoutMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveClampLayoutMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveClampLayoutMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveClampLayoutMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveClampLayoutMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveClampLayoutMethod "getLayoutChild" o = Gtk.LayoutManager.LayoutManagerGetLayoutChildMethodInfo
    ResolveClampLayoutMethod "getMaximumSize" o = ClampLayoutGetMaximumSizeMethodInfo
    ResolveClampLayoutMethod "getOrientation" o = Gtk.Orientable.OrientableGetOrientationMethodInfo
    ResolveClampLayoutMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveClampLayoutMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveClampLayoutMethod "getRequestMode" o = Gtk.LayoutManager.LayoutManagerGetRequestModeMethodInfo
    ResolveClampLayoutMethod "getTighteningThreshold" o = ClampLayoutGetTighteningThresholdMethodInfo
    ResolveClampLayoutMethod "getWidget" o = Gtk.LayoutManager.LayoutManagerGetWidgetMethodInfo
    ResolveClampLayoutMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveClampLayoutMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveClampLayoutMethod "setMaximumSize" o = ClampLayoutSetMaximumSizeMethodInfo
    ResolveClampLayoutMethod "setOrientation" o = Gtk.Orientable.OrientableSetOrientationMethodInfo
    ResolveClampLayoutMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveClampLayoutMethod "setTighteningThreshold" o = ClampLayoutSetTighteningThresholdMethodInfo
    ResolveClampLayoutMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ClampLayoutMaximumSizePropertyInfo
instance AttrInfo ClampLayoutMaximumSizePropertyInfo where
    type AttrAllowedOps ClampLayoutMaximumSizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClampLayoutMaximumSizePropertyInfo = IsClampLayout
    type AttrSetTypeConstraint ClampLayoutMaximumSizePropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ClampLayoutMaximumSizePropertyInfo = (~) Int32
    type AttrTransferType ClampLayoutMaximumSizePropertyInfo = Int32
    type AttrGetType ClampLayoutMaximumSizePropertyInfo = Int32
    type AttrLabel ClampLayoutMaximumSizePropertyInfo = "maximum-size"
    type AttrOrigin ClampLayoutMaximumSizePropertyInfo = ClampLayout
    attrGet = getClampLayoutMaximumSize
    attrSet = setClampLayoutMaximumSize
    attrTransfer _ v = do
        return v
    attrConstruct = constructClampLayoutMaximumSize
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.ClampLayout.maximumSize"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-ClampLayout.html#g:attr:maximumSize"
        })
#endif

-- VVV Prop "tightening-threshold"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

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

#if defined(ENABLE_OVERLOADING)
data ClampLayoutTighteningThresholdPropertyInfo
instance AttrInfo ClampLayoutTighteningThresholdPropertyInfo where
    type AttrAllowedOps ClampLayoutTighteningThresholdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ClampLayoutTighteningThresholdPropertyInfo = IsClampLayout
    type AttrSetTypeConstraint ClampLayoutTighteningThresholdPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint ClampLayoutTighteningThresholdPropertyInfo = (~) Int32
    type AttrTransferType ClampLayoutTighteningThresholdPropertyInfo = Int32
    type AttrGetType ClampLayoutTighteningThresholdPropertyInfo = Int32
    type AttrLabel ClampLayoutTighteningThresholdPropertyInfo = "tightening-threshold"
    type AttrOrigin ClampLayoutTighteningThresholdPropertyInfo = ClampLayout
    attrGet = getClampLayoutTighteningThreshold
    attrSet = setClampLayoutTighteningThreshold
    attrTransfer _ v = do
        return v
    attrConstruct = constructClampLayoutTighteningThreshold
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.ClampLayout.tighteningThreshold"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-ClampLayout.html#g:attr:tighteningThreshold"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ClampLayout
type instance O.AttributeList ClampLayout = ClampLayoutAttributeList
type ClampLayoutAttributeList = ('[ '("maximumSize", ClampLayoutMaximumSizePropertyInfo), '("orientation", Gtk.Orientable.OrientableOrientationPropertyInfo), '("tighteningThreshold", ClampLayoutTighteningThresholdPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
clampLayoutMaximumSize :: AttrLabelProxy "maximumSize"
clampLayoutMaximumSize = AttrLabelProxy

clampLayoutTighteningThreshold :: AttrLabelProxy "tighteningThreshold"
clampLayoutTighteningThreshold = AttrLabelProxy

#endif

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

#endif

-- method ClampLayout::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Adw" , name = "ClampLayout" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_clamp_layout_new" adw_clamp_layout_new :: 
    IO (Ptr ClampLayout)

-- | Creates a new @AdwClampLayout@.
clampLayoutNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ClampLayout
    -- ^ __Returns:__ the newly created @AdwClampLayout@
clampLayoutNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m ClampLayout
clampLayoutNew  = IO ClampLayout -> m ClampLayout
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ClampLayout -> m ClampLayout)
-> IO ClampLayout -> m ClampLayout
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClampLayout
result <- IO (Ptr ClampLayout)
adw_clamp_layout_new
    Text -> Ptr ClampLayout -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"clampLayoutNew" Ptr ClampLayout
result
    ClampLayout
result' <- ((ManagedPtr ClampLayout -> ClampLayout)
-> Ptr ClampLayout -> IO ClampLayout
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ClampLayout -> ClampLayout
ClampLayout) Ptr ClampLayout
result
    ClampLayout -> IO ClampLayout
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ClampLayout
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Gets the maximum size allocated to the children.
clampLayoutGetMaximumSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsClampLayout a) =>
    a
    -- ^ /@self@/: a clamp layout
    -> m Int32
    -- ^ __Returns:__ the maximum size to allocate to the children
clampLayoutGetMaximumSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClampLayout a) =>
a -> m Int32
clampLayoutGetMaximumSize a
self = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClampLayout
self' <- a -> IO (Ptr ClampLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr ClampLayout -> IO Int32
adw_clamp_layout_get_maximum_size Ptr ClampLayout
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ClampLayoutGetMaximumSizeMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsClampLayout a) => O.OverloadedMethod ClampLayoutGetMaximumSizeMethodInfo a signature where
    overloadedMethod = clampLayoutGetMaximumSize

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


#endif

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

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

-- | Gets the size above which the children are clamped.
clampLayoutGetTighteningThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsClampLayout a) =>
    a
    -- ^ /@self@/: a clamp layout
    -> m Int32
    -- ^ __Returns:__ the size above which the children are clamped
clampLayoutGetTighteningThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClampLayout a) =>
a -> m Int32
clampLayoutGetTighteningThreshold a
self = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClampLayout
self' <- a -> IO (Ptr ClampLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr ClampLayout -> IO Int32
adw_clamp_layout_get_tightening_threshold Ptr ClampLayout
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data ClampLayoutGetTighteningThresholdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsClampLayout a) => O.OverloadedMethod ClampLayoutGetTighteningThresholdMethodInfo a signature where
    overloadedMethod = clampLayoutGetTighteningThreshold

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


#endif

-- method ClampLayout::set_maximum_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ClampLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a clamp layout" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "maximum_size"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the maximum size" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_clamp_layout_set_maximum_size" adw_clamp_layout_set_maximum_size :: 
    Ptr ClampLayout ->                      -- self : TInterface (Name {namespace = "Adw", name = "ClampLayout"})
    Int32 ->                                -- maximum_size : TBasicType TInt
    IO ()

-- | Sets the maximum size allocated to the children.
-- 
-- It is the width if the layout is horizontal, or the height if it is vertical.
clampLayoutSetMaximumSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsClampLayout a) =>
    a
    -- ^ /@self@/: a clamp layout
    -> Int32
    -- ^ /@maximumSize@/: the maximum size
    -> m ()
clampLayoutSetMaximumSize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClampLayout a) =>
a -> Int32 -> m ()
clampLayoutSetMaximumSize a
self Int32
maximumSize = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClampLayout
self' <- a -> IO (Ptr ClampLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ClampLayout -> Int32 -> IO ()
adw_clamp_layout_set_maximum_size Ptr ClampLayout
self' Int32
maximumSize
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClampLayoutSetMaximumSizeMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsClampLayout a) => O.OverloadedMethod ClampLayoutSetMaximumSizeMethodInfo a signature where
    overloadedMethod = clampLayoutSetMaximumSize

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


#endif

-- method ClampLayout::set_tightening_threshold
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ClampLayout" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a clamp layout" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tightening_threshold"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the tightening threshold"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_clamp_layout_set_tightening_threshold" adw_clamp_layout_set_tightening_threshold :: 
    Ptr ClampLayout ->                      -- self : TInterface (Name {namespace = "Adw", name = "ClampLayout"})
    Int32 ->                                -- tightening_threshold : TBasicType TInt
    IO ()

-- | Sets the size above which the children are clamped.
-- 
-- Starting from this size, the layout will tighten its grip on the children,
-- slowly allocating less and less of the available size up to the maximum
-- allocated size. Below that threshold and below the maximum size, the children
-- will be allocated all the available size.
-- 
-- If the threshold is greater than the maximum size to allocate to the
-- children, they will be allocated the whole size up to the maximum. If the
-- threshold is lower than the minimum size to allocate to the children, that
-- size will be used as the tightening threshold.
-- 
-- Effectively, tightening the grip on a child before it reaches its maximum
-- size makes transitions to and from the maximum size smoother when resizing.
clampLayoutSetTighteningThreshold ::
    (B.CallStack.HasCallStack, MonadIO m, IsClampLayout a) =>
    a
    -- ^ /@self@/: a clamp layout
    -> Int32
    -- ^ /@tighteningThreshold@/: the tightening threshold
    -> m ()
clampLayoutSetTighteningThreshold :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsClampLayout a) =>
a -> Int32 -> m ()
clampLayoutSetTighteningThreshold a
self Int32
tighteningThreshold = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ClampLayout
self' <- a -> IO (Ptr ClampLayout)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ClampLayout -> Int32 -> IO ()
adw_clamp_layout_set_tightening_threshold Ptr ClampLayout
self' Int32
tighteningThreshold
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ClampLayoutSetTighteningThresholdMethodInfo
instance (signature ~ (Int32 -> m ()), MonadIO m, IsClampLayout a) => O.OverloadedMethod ClampLayoutSetTighteningThresholdMethodInfo a signature where
    overloadedMethod = clampLayoutSetTighteningThreshold

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


#endif