{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gtk.Objects.ProgressBar.ProgressBar' is typically used to display the progress of a long
-- running operation. It provides a visual clue that processing is underway.
-- The GtkProgressBar can be used in two different modes: percentage mode
-- and activity mode.
-- 
-- When an application can determine how much work needs to take place
-- (e.g. read a fixed number of bytes from a file) and can monitor its
-- progress, it can use the GtkProgressBar in percentage mode and the
-- user sees a growing bar indicating the percentage of the work that
-- has been completed. In this mode, the application is required to call
-- 'GI.Gtk.Objects.ProgressBar.progressBarSetFraction' periodically to update the progress bar.
-- 
-- When an application has no accurate way of knowing the amount of work
-- to do, it can use the t'GI.Gtk.Objects.ProgressBar.ProgressBar' in activity mode, which shows
-- activity by a block moving back and forth within the progress area. In
-- this mode, the application is required to call 'GI.Gtk.Objects.ProgressBar.progressBarPulse'
-- periodically to update the progress bar.
-- 
-- There is quite a bit of flexibility provided to control the appearance
-- of the t'GI.Gtk.Objects.ProgressBar.ProgressBar'. Functions are provided to control the orientation
-- of the bar, optional text can be displayed along with the bar, and the
-- step size used in activity mode can be set.
-- 
-- = CSS nodes
-- 
-- 
-- === /plain code/
-- >
-- >progressbar[.osd]
-- >├── [text]
-- >╰── trough[.empty][.full]
-- >    ╰── progress[.pulse]
-- 
-- 
-- GtkProgressBar has a main CSS node with name progressbar and subnodes with
-- names text and trough, of which the latter has a subnode named progress. The
-- text subnode is only present if text is shown. The progress subnode has the
-- style class .pulse when in activity mode. It gets the style classes .left,
-- .right, .top or .bottom added when the progress \'touches\' the corresponding
-- end of the GtkProgressBar. The .osd class on the progressbar node is for use
-- in overlays like the one Epiphany has for page loading progress.

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

module GI.Gtk.Objects.ProgressBar
    ( 

-- * Exported types
    ProgressBar(..)                         ,
    IsProgressBar                           ,
    toProgressBar                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveProgressBarMethod                ,
#endif


-- ** getEllipsize #method:getEllipsize#

#if defined(ENABLE_OVERLOADING)
    ProgressBarGetEllipsizeMethodInfo       ,
#endif
    progressBarGetEllipsize                 ,


-- ** getFraction #method:getFraction#

#if defined(ENABLE_OVERLOADING)
    ProgressBarGetFractionMethodInfo        ,
#endif
    progressBarGetFraction                  ,


-- ** getInverted #method:getInverted#

#if defined(ENABLE_OVERLOADING)
    ProgressBarGetInvertedMethodInfo        ,
#endif
    progressBarGetInverted                  ,


-- ** getPulseStep #method:getPulseStep#

#if defined(ENABLE_OVERLOADING)
    ProgressBarGetPulseStepMethodInfo       ,
#endif
    progressBarGetPulseStep                 ,


-- ** getShowText #method:getShowText#

#if defined(ENABLE_OVERLOADING)
    ProgressBarGetShowTextMethodInfo        ,
#endif
    progressBarGetShowText                  ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    ProgressBarGetTextMethodInfo            ,
#endif
    progressBarGetText                      ,


-- ** new #method:new#

    progressBarNew                          ,


-- ** pulse #method:pulse#

#if defined(ENABLE_OVERLOADING)
    ProgressBarPulseMethodInfo              ,
#endif
    progressBarPulse                        ,


-- ** setEllipsize #method:setEllipsize#

#if defined(ENABLE_OVERLOADING)
    ProgressBarSetEllipsizeMethodInfo       ,
#endif
    progressBarSetEllipsize                 ,


-- ** setFraction #method:setFraction#

#if defined(ENABLE_OVERLOADING)
    ProgressBarSetFractionMethodInfo        ,
#endif
    progressBarSetFraction                  ,


-- ** setInverted #method:setInverted#

#if defined(ENABLE_OVERLOADING)
    ProgressBarSetInvertedMethodInfo        ,
#endif
    progressBarSetInverted                  ,


-- ** setPulseStep #method:setPulseStep#

#if defined(ENABLE_OVERLOADING)
    ProgressBarSetPulseStepMethodInfo       ,
#endif
    progressBarSetPulseStep                 ,


-- ** setShowText #method:setShowText#

#if defined(ENABLE_OVERLOADING)
    ProgressBarSetShowTextMethodInfo        ,
#endif
    progressBarSetShowText                  ,


-- ** setText #method:setText#

#if defined(ENABLE_OVERLOADING)
    ProgressBarSetTextMethodInfo            ,
#endif
    progressBarSetText                      ,




 -- * Properties
-- ** ellipsize #attr:ellipsize#
-- | The preferred place to ellipsize the string, if the progress bar does
-- not have enough room to display the entire string, specified as a
-- t'GI.Pango.Enums.EllipsizeMode'.
-- 
-- Note that setting this property to a value other than
-- 'GI.Pango.Enums.EllipsizeModeNone' has the side-effect that the progress bar requests
-- only enough space to display the ellipsis (\"...\"). Another means to set a
-- progress bar\'s width is 'GI.Gtk.Objects.Widget.widgetSetSizeRequest'.

#if defined(ENABLE_OVERLOADING)
    ProgressBarEllipsizePropertyInfo        ,
#endif
    constructProgressBarEllipsize           ,
    getProgressBarEllipsize                 ,
#if defined(ENABLE_OVERLOADING)
    progressBarEllipsize                    ,
#endif
    setProgressBarEllipsize                 ,


-- ** fraction #attr:fraction#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ProgressBarFractionPropertyInfo         ,
#endif
    constructProgressBarFraction            ,
    getProgressBarFraction                  ,
#if defined(ENABLE_OVERLOADING)
    progressBarFraction                     ,
#endif
    setProgressBarFraction                  ,


-- ** inverted #attr:inverted#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ProgressBarInvertedPropertyInfo         ,
#endif
    constructProgressBarInverted            ,
    getProgressBarInverted                  ,
#if defined(ENABLE_OVERLOADING)
    progressBarInverted                     ,
#endif
    setProgressBarInverted                  ,


-- ** pulseStep #attr:pulseStep#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ProgressBarPulseStepPropertyInfo        ,
#endif
    constructProgressBarPulseStep           ,
    getProgressBarPulseStep                 ,
#if defined(ENABLE_OVERLOADING)
    progressBarPulseStep                    ,
#endif
    setProgressBarPulseStep                 ,


-- ** showText #attr:showText#
-- | Sets whether the progress bar will show a text in addition
-- to the bar itself. The shown text is either the value of
-- the t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/text/@ property or, if that is 'P.Nothing',
-- the t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/fraction/@ value, as a percentage.
-- 
-- To make a progress bar that is styled and sized suitably for
-- showing text (even if the actual text is blank), set
-- t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/show-text/@ to 'P.True' and t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/text/@
-- to the empty string (not 'P.Nothing').

#if defined(ENABLE_OVERLOADING)
    ProgressBarShowTextPropertyInfo         ,
#endif
    constructProgressBarShowText            ,
    getProgressBarShowText                  ,
#if defined(ENABLE_OVERLOADING)
    progressBarShowText                     ,
#endif
    setProgressBarShowText                  ,


-- ** text #attr:text#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    ProgressBarTextPropertyInfo             ,
#endif
    clearProgressBarText                    ,
    constructProgressBarText                ,
    getProgressBarText                      ,
#if defined(ENABLE_OVERLOADING)
    progressBarText                         ,
#endif
    setProgressBarText                      ,




    ) where

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

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

import qualified GI.Atk.Interfaces.ImplementorIface as Atk.ImplementorIface
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Orientable as Gtk.Orientable
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Pango.Enums as Pango.Enums

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

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

foreign import ccall "gtk_progress_bar_get_type"
    c_gtk_progress_bar_get_type :: IO B.Types.GType

instance B.Types.TypedObject ProgressBar where
    glibType :: IO GType
glibType = IO GType
c_gtk_progress_bar_get_type

instance B.Types.GObject ProgressBar

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

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

instance O.HasParentTypes ProgressBar
type instance O.ParentTypes ProgressBar = '[Gtk.Widget.Widget, GObject.Object.Object, Atk.ImplementorIface.ImplementorIface, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Orientable.Orientable]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveProgressBarMethod (t :: Symbol) (o :: *) :: * where
    ResolveProgressBarMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveProgressBarMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveProgressBarMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveProgressBarMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveProgressBarMethod "addChild" o = Gtk.Buildable.BuildableAddChildMethodInfo
    ResolveProgressBarMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveProgressBarMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveProgressBarMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveProgressBarMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveProgressBarMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveProgressBarMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveProgressBarMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveProgressBarMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveProgressBarMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveProgressBarMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveProgressBarMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveProgressBarMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveProgressBarMethod "constructChild" o = Gtk.Buildable.BuildableConstructChildMethodInfo
    ResolveProgressBarMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveProgressBarMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveProgressBarMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveProgressBarMethod "customFinished" o = Gtk.Buildable.BuildableCustomFinishedMethodInfo
    ResolveProgressBarMethod "customTagEnd" o = Gtk.Buildable.BuildableCustomTagEndMethodInfo
    ResolveProgressBarMethod "customTagStart" o = Gtk.Buildable.BuildableCustomTagStartMethodInfo
    ResolveProgressBarMethod "deviceIsShadowed" o = Gtk.Widget.WidgetDeviceIsShadowedMethodInfo
    ResolveProgressBarMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveProgressBarMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveProgressBarMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveProgressBarMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveProgressBarMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveProgressBarMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveProgressBarMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveProgressBarMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveProgressBarMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveProgressBarMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveProgressBarMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveProgressBarMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveProgressBarMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveProgressBarMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveProgressBarMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveProgressBarMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveProgressBarMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveProgressBarMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveProgressBarMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveProgressBarMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveProgressBarMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveProgressBarMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveProgressBarMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveProgressBarMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveProgressBarMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveProgressBarMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveProgressBarMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveProgressBarMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveProgressBarMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveProgressBarMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveProgressBarMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveProgressBarMethod "parserFinished" o = Gtk.Buildable.BuildableParserFinishedMethodInfo
    ResolveProgressBarMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveProgressBarMethod "pulse" o = ProgressBarPulseMethodInfo
    ResolveProgressBarMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveProgressBarMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveProgressBarMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveProgressBarMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveProgressBarMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveProgressBarMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveProgressBarMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveProgressBarMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveProgressBarMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveProgressBarMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveProgressBarMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveProgressBarMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveProgressBarMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveProgressBarMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveProgressBarMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveProgressBarMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveProgressBarMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveProgressBarMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveProgressBarMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveProgressBarMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveProgressBarMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveProgressBarMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveProgressBarMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveProgressBarMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveProgressBarMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveProgressBarMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveProgressBarMethod "getAccessible" o = Gtk.Widget.WidgetGetAccessibleMethodInfo
    ResolveProgressBarMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveProgressBarMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveProgressBarMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveProgressBarMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveProgressBarMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveProgressBarMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveProgressBarMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveProgressBarMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveProgressBarMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveProgressBarMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveProgressBarMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveProgressBarMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveProgressBarMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveProgressBarMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveProgressBarMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveProgressBarMethod "getEllipsize" o = ProgressBarGetEllipsizeMethodInfo
    ResolveProgressBarMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveProgressBarMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveProgressBarMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveProgressBarMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveProgressBarMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveProgressBarMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveProgressBarMethod "getFraction" o = ProgressBarGetFractionMethodInfo
    ResolveProgressBarMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveProgressBarMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveProgressBarMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveProgressBarMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveProgressBarMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveProgressBarMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveProgressBarMethod "getInternalChild" o = Gtk.Buildable.BuildableGetInternalChildMethodInfo
    ResolveProgressBarMethod "getInverted" o = ProgressBarGetInvertedMethodInfo
    ResolveProgressBarMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveProgressBarMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveProgressBarMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveProgressBarMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveProgressBarMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveProgressBarMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveProgressBarMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveProgressBarMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveProgressBarMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveProgressBarMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveProgressBarMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveProgressBarMethod "getOrientation" o = Gtk.Orientable.OrientableGetOrientationMethodInfo
    ResolveProgressBarMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveProgressBarMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveProgressBarMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveProgressBarMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveProgressBarMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveProgressBarMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveProgressBarMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveProgressBarMethod "getPulseStep" o = ProgressBarGetPulseStepMethodInfo
    ResolveProgressBarMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveProgressBarMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveProgressBarMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveProgressBarMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveProgressBarMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveProgressBarMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveProgressBarMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveProgressBarMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveProgressBarMethod "getShowText" o = ProgressBarGetShowTextMethodInfo
    ResolveProgressBarMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveProgressBarMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveProgressBarMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveProgressBarMethod "getSupportMultidevice" o = Gtk.Widget.WidgetGetSupportMultideviceMethodInfo
    ResolveProgressBarMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveProgressBarMethod "getText" o = ProgressBarGetTextMethodInfo
    ResolveProgressBarMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveProgressBarMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveProgressBarMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveProgressBarMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveProgressBarMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveProgressBarMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveProgressBarMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveProgressBarMethod "setBuildableProperty" o = Gtk.Buildable.BuildableSetBuildablePropertyMethodInfo
    ResolveProgressBarMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveProgressBarMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveProgressBarMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveProgressBarMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveProgressBarMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveProgressBarMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveProgressBarMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveProgressBarMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveProgressBarMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveProgressBarMethod "setEllipsize" o = ProgressBarSetEllipsizeMethodInfo
    ResolveProgressBarMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveProgressBarMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveProgressBarMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveProgressBarMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveProgressBarMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveProgressBarMethod "setFraction" o = ProgressBarSetFractionMethodInfo
    ResolveProgressBarMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveProgressBarMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveProgressBarMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveProgressBarMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveProgressBarMethod "setInverted" o = ProgressBarSetInvertedMethodInfo
    ResolveProgressBarMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveProgressBarMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveProgressBarMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveProgressBarMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveProgressBarMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveProgressBarMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveProgressBarMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveProgressBarMethod "setOrientation" o = Gtk.Orientable.OrientableSetOrientationMethodInfo
    ResolveProgressBarMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveProgressBarMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveProgressBarMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveProgressBarMethod "setPulseStep" o = ProgressBarSetPulseStepMethodInfo
    ResolveProgressBarMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveProgressBarMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveProgressBarMethod "setShowText" o = ProgressBarSetShowTextMethodInfo
    ResolveProgressBarMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveProgressBarMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveProgressBarMethod "setSupportMultidevice" o = Gtk.Widget.WidgetSetSupportMultideviceMethodInfo
    ResolveProgressBarMethod "setText" o = ProgressBarSetTextMethodInfo
    ResolveProgressBarMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveProgressBarMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveProgressBarMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveProgressBarMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveProgressBarMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveProgressBarMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveProgressBarMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "ellipsize"
   -- Type: TInterface (Name {namespace = "Pango", name = "EllipsizeMode"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@ellipsize@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progressBar [ #ellipsize 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressBarEllipsize :: (MonadIO m, IsProgressBar o) => o -> Pango.Enums.EllipsizeMode -> m ()
setProgressBarEllipsize :: o -> EllipsizeMode -> m ()
setProgressBarEllipsize o
obj EllipsizeMode
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> EllipsizeMode -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"ellipsize" EllipsizeMode
val

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

#if defined(ENABLE_OVERLOADING)
data ProgressBarEllipsizePropertyInfo
instance AttrInfo ProgressBarEllipsizePropertyInfo where
    type AttrAllowedOps ProgressBarEllipsizePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ProgressBarEllipsizePropertyInfo = IsProgressBar
    type AttrSetTypeConstraint ProgressBarEllipsizePropertyInfo = (~) Pango.Enums.EllipsizeMode
    type AttrTransferTypeConstraint ProgressBarEllipsizePropertyInfo = (~) Pango.Enums.EllipsizeMode
    type AttrTransferType ProgressBarEllipsizePropertyInfo = Pango.Enums.EllipsizeMode
    type AttrGetType ProgressBarEllipsizePropertyInfo = Pango.Enums.EllipsizeMode
    type AttrLabel ProgressBarEllipsizePropertyInfo = "ellipsize"
    type AttrOrigin ProgressBarEllipsizePropertyInfo = ProgressBar
    attrGet = getProgressBarEllipsize
    attrSet = setProgressBarEllipsize
    attrTransfer _ v = do
        return v
    attrConstruct = constructProgressBarEllipsize
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ProgressBarFractionPropertyInfo
instance AttrInfo ProgressBarFractionPropertyInfo where
    type AttrAllowedOps ProgressBarFractionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ProgressBarFractionPropertyInfo = IsProgressBar
    type AttrSetTypeConstraint ProgressBarFractionPropertyInfo = (~) Double
    type AttrTransferTypeConstraint ProgressBarFractionPropertyInfo = (~) Double
    type AttrTransferType ProgressBarFractionPropertyInfo = Double
    type AttrGetType ProgressBarFractionPropertyInfo = Double
    type AttrLabel ProgressBarFractionPropertyInfo = "fraction"
    type AttrOrigin ProgressBarFractionPropertyInfo = ProgressBar
    attrGet = getProgressBarFraction
    attrSet = setProgressBarFraction
    attrTransfer _ v = do
        return v
    attrConstruct = constructProgressBarFraction
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ProgressBarInvertedPropertyInfo
instance AttrInfo ProgressBarInvertedPropertyInfo where
    type AttrAllowedOps ProgressBarInvertedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ProgressBarInvertedPropertyInfo = IsProgressBar
    type AttrSetTypeConstraint ProgressBarInvertedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ProgressBarInvertedPropertyInfo = (~) Bool
    type AttrTransferType ProgressBarInvertedPropertyInfo = Bool
    type AttrGetType ProgressBarInvertedPropertyInfo = Bool
    type AttrLabel ProgressBarInvertedPropertyInfo = "inverted"
    type AttrOrigin ProgressBarInvertedPropertyInfo = ProgressBar
    attrGet = getProgressBarInverted
    attrSet = setProgressBarInverted
    attrTransfer _ v = do
        return v
    attrConstruct = constructProgressBarInverted
    attrClear = undefined
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data ProgressBarPulseStepPropertyInfo
instance AttrInfo ProgressBarPulseStepPropertyInfo where
    type AttrAllowedOps ProgressBarPulseStepPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ProgressBarPulseStepPropertyInfo = IsProgressBar
    type AttrSetTypeConstraint ProgressBarPulseStepPropertyInfo = (~) Double
    type AttrTransferTypeConstraint ProgressBarPulseStepPropertyInfo = (~) Double
    type AttrTransferType ProgressBarPulseStepPropertyInfo = Double
    type AttrGetType ProgressBarPulseStepPropertyInfo = Double
    type AttrLabel ProgressBarPulseStepPropertyInfo = "pulse-step"
    type AttrOrigin ProgressBarPulseStepPropertyInfo = ProgressBar
    attrGet = getProgressBarPulseStep
    attrSet = setProgressBarPulseStep
    attrTransfer _ v = do
        return v
    attrConstruct = constructProgressBarPulseStep
    attrClear = undefined
#endif

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

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

-- | Set the value of the “@show-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progressBar [ #showText 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressBarShowText :: (MonadIO m, IsProgressBar o) => o -> Bool -> m ()
setProgressBarShowText :: o -> Bool -> m ()
setProgressBarShowText o
obj Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"show-text" Bool
val

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

#if defined(ENABLE_OVERLOADING)
data ProgressBarShowTextPropertyInfo
instance AttrInfo ProgressBarShowTextPropertyInfo where
    type AttrAllowedOps ProgressBarShowTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint ProgressBarShowTextPropertyInfo = IsProgressBar
    type AttrSetTypeConstraint ProgressBarShowTextPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint ProgressBarShowTextPropertyInfo = (~) Bool
    type AttrTransferType ProgressBarShowTextPropertyInfo = Bool
    type AttrGetType ProgressBarShowTextPropertyInfo = Bool
    type AttrLabel ProgressBarShowTextPropertyInfo = "show-text"
    type AttrOrigin ProgressBarShowTextPropertyInfo = ProgressBar
    attrGet = getProgressBarShowText
    attrSet = setProgressBarShowText
    attrTransfer _ v = do
        return v
    attrConstruct = constructProgressBarShowText
    attrClear = undefined
#endif

-- VVV Prop "text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

-- | Get the value of the “@text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' progressBar #text
-- @
getProgressBarText :: (MonadIO m, IsProgressBar o) => o -> m (Maybe T.Text)
getProgressBarText :: o -> m (Maybe Text)
getProgressBarText o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"text"

-- | Set the value of the “@text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' progressBar [ #text 'Data.GI.Base.Attributes.:=' value ]
-- @
setProgressBarText :: (MonadIO m, IsProgressBar o) => o -> T.Text -> m ()
setProgressBarText :: o -> Text -> m ()
setProgressBarText o
obj Text
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@text@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructProgressBarText :: (IsProgressBar o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructProgressBarText :: Text -> m (GValueConstruct o)
constructProgressBarText Text
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
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"text" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@text@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #text
-- @
clearProgressBarText :: (MonadIO m, IsProgressBar o) => o -> m ()
clearProgressBarText :: o -> m ()
clearProgressBarText o
obj = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"text" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data ProgressBarTextPropertyInfo
instance AttrInfo ProgressBarTextPropertyInfo where
    type AttrAllowedOps ProgressBarTextPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint ProgressBarTextPropertyInfo = IsProgressBar
    type AttrSetTypeConstraint ProgressBarTextPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint ProgressBarTextPropertyInfo = (~) T.Text
    type AttrTransferType ProgressBarTextPropertyInfo = T.Text
    type AttrGetType ProgressBarTextPropertyInfo = (Maybe T.Text)
    type AttrLabel ProgressBarTextPropertyInfo = "text"
    type AttrOrigin ProgressBarTextPropertyInfo = ProgressBar
    attrGet = getProgressBarText
    attrSet = setProgressBarText
    attrTransfer _ v = do
        return v
    attrConstruct = constructProgressBarText
    attrClear = clearProgressBarText
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ProgressBar
type instance O.AttributeList ProgressBar = ProgressBarAttributeList
type ProgressBarAttributeList = ('[ '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("ellipsize", ProgressBarEllipsizePropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("fraction", ProgressBarFractionPropertyInfo), '("halign", Gtk.Widget.WidgetHalignPropertyInfo), '("hasDefault", Gtk.Widget.WidgetHasDefaultPropertyInfo), '("hasFocus", Gtk.Widget.WidgetHasFocusPropertyInfo), '("hasTooltip", Gtk.Widget.WidgetHasTooltipPropertyInfo), '("heightRequest", Gtk.Widget.WidgetHeightRequestPropertyInfo), '("hexpand", Gtk.Widget.WidgetHexpandPropertyInfo), '("hexpandSet", Gtk.Widget.WidgetHexpandSetPropertyInfo), '("inverted", ProgressBarInvertedPropertyInfo), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("orientation", Gtk.Orientable.OrientableOrientationPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("pulseStep", ProgressBarPulseStepPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("showText", ProgressBarShowTextPropertyInfo), '("text", ProgressBarTextPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
progressBarEllipsize :: AttrLabelProxy "ellipsize"
progressBarEllipsize = AttrLabelProxy

progressBarFraction :: AttrLabelProxy "fraction"
progressBarFraction = AttrLabelProxy

progressBarInverted :: AttrLabelProxy "inverted"
progressBarInverted = AttrLabelProxy

progressBarPulseStep :: AttrLabelProxy "pulseStep"
progressBarPulseStep = AttrLabelProxy

progressBarShowText :: AttrLabelProxy "showText"
progressBarShowText = AttrLabelProxy

progressBarText :: AttrLabelProxy "text"
progressBarText = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ProgressBar = ProgressBarSignalList
type ProgressBarSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("grabNotify", Gtk.Widget.WidgetGrabNotifySignalInfo), '("hide", Gtk.Widget.WidgetHideSignalInfo), '("keynavFailed", Gtk.Widget.WidgetKeynavFailedSignalInfo), '("map", Gtk.Widget.WidgetMapSignalInfo), '("mnemonicActivate", Gtk.Widget.WidgetMnemonicActivateSignalInfo), '("moveFocus", Gtk.Widget.WidgetMoveFocusSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("queryTooltip", Gtk.Widget.WidgetQueryTooltipSignalInfo), '("realize", Gtk.Widget.WidgetRealizeSignalInfo), '("show", Gtk.Widget.WidgetShowSignalInfo), '("stateFlagsChanged", Gtk.Widget.WidgetStateFlagsChangedSignalInfo), '("unmap", Gtk.Widget.WidgetUnmapSignalInfo), '("unrealize", Gtk.Widget.WidgetUnrealizeSignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "gtk_progress_bar_new" gtk_progress_bar_new :: 
    IO (Ptr ProgressBar)

-- | Creates a new t'GI.Gtk.Objects.ProgressBar.ProgressBar'.
progressBarNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ProgressBar
    -- ^ __Returns:__ a t'GI.Gtk.Objects.ProgressBar.ProgressBar'.
progressBarNew :: m ProgressBar
progressBarNew  = IO ProgressBar -> m ProgressBar
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ProgressBar -> m ProgressBar)
-> IO ProgressBar -> m ProgressBar
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProgressBar
result <- IO (Ptr ProgressBar)
gtk_progress_bar_new
    Text -> Ptr ProgressBar -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"progressBarNew" Ptr ProgressBar
result
    ProgressBar
result' <- ((ManagedPtr ProgressBar -> ProgressBar)
-> Ptr ProgressBar -> IO ProgressBar
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ProgressBar -> ProgressBar
ProgressBar) Ptr ProgressBar
result
    ProgressBar -> IO ProgressBar
forall (m :: * -> *) a. Monad m => a -> m a
return ProgressBar
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ProgressBar::get_ellipsize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Pango" , name = "EllipsizeMode" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_get_ellipsize" gtk_progress_bar_get_ellipsize :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO CUInt

-- | Returns the ellipsizing position of the progress bar.
-- See 'GI.Gtk.Objects.ProgressBar.progressBarSetEllipsize'.
progressBarGetEllipsize ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m Pango.Enums.EllipsizeMode
    -- ^ __Returns:__ t'GI.Pango.Enums.EllipsizeMode'
progressBarGetEllipsize :: a -> m EllipsizeMode
progressBarGetEllipsize a
pbar = IO EllipsizeMode -> m EllipsizeMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EllipsizeMode -> m EllipsizeMode)
-> IO EllipsizeMode -> m EllipsizeMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CUInt
result <- Ptr ProgressBar -> IO CUInt
gtk_progress_bar_get_ellipsize Ptr ProgressBar
pbar'
    let result' :: EllipsizeMode
result' = (Int -> EllipsizeMode
forall a. Enum a => Int -> a
toEnum (Int -> EllipsizeMode) -> (CUInt -> Int) -> CUInt -> EllipsizeMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    EllipsizeMode -> IO EllipsizeMode
forall (m :: * -> *) a. Monad m => a -> m a
return EllipsizeMode
result'

#if defined(ENABLE_OVERLOADING)
data ProgressBarGetEllipsizeMethodInfo
instance (signature ~ (m Pango.Enums.EllipsizeMode), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarGetEllipsizeMethodInfo a signature where
    overloadedMethod = progressBarGetEllipsize

#endif

-- method ProgressBar::get_fraction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , 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_progress_bar_get_fraction" gtk_progress_bar_get_fraction :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO CDouble

-- | Returns the current fraction of the task that’s been completed.
progressBarGetFraction ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m Double
    -- ^ __Returns:__ a fraction from 0.0 to 1.0
progressBarGetFraction :: a -> m Double
progressBarGetFraction a
pbar = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CDouble
result <- Ptr ProgressBar -> IO CDouble
gtk_progress_bar_get_fraction Ptr ProgressBar
pbar'
    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
pbar
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ProgressBarGetFractionMethodInfo
instance (signature ~ (m Double), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarGetFractionMethodInfo a signature where
    overloadedMethod = progressBarGetFraction

#endif

-- method ProgressBar::get_inverted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_get_inverted" gtk_progress_bar_get_inverted :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO CInt

-- | Gets the value set by 'GI.Gtk.Objects.ProgressBar.progressBarSetInverted'.
progressBarGetInverted ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the progress bar is inverted
progressBarGetInverted :: a -> m Bool
progressBarGetInverted a
pbar = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CInt
result <- Ptr ProgressBar -> IO CInt
gtk_progress_bar_get_inverted Ptr ProgressBar
pbar'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ProgressBarGetInvertedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarGetInvertedMethodInfo a signature where
    overloadedMethod = progressBarGetInverted

#endif

-- method ProgressBar::get_pulse_step
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , 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_progress_bar_get_pulse_step" gtk_progress_bar_get_pulse_step :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO CDouble

-- | Retrieves the pulse step set with 'GI.Gtk.Objects.ProgressBar.progressBarSetPulseStep'.
progressBarGetPulseStep ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m Double
    -- ^ __Returns:__ a fraction from 0.0 to 1.0
progressBarGetPulseStep :: a -> m Double
progressBarGetPulseStep a
pbar = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CDouble
result <- Ptr ProgressBar -> IO CDouble
gtk_progress_bar_get_pulse_step Ptr ProgressBar
pbar'
    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
pbar
    Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data ProgressBarGetPulseStepMethodInfo
instance (signature ~ (m Double), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarGetPulseStepMethodInfo a signature where
    overloadedMethod = progressBarGetPulseStep

#endif

-- method ProgressBar::get_show_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_get_show_text" gtk_progress_bar_get_show_text :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO CInt

-- | Gets the value of the t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/show-text/@ property.
-- See 'GI.Gtk.Objects.ProgressBar.progressBarSetShowText'.
progressBarGetShowText ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if text is shown in the progress bar
progressBarGetShowText :: a -> m Bool
progressBarGetShowText a
pbar = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CInt
result <- Ptr ProgressBar -> IO CInt
gtk_progress_bar_get_show_text Ptr ProgressBar
pbar'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ProgressBarGetShowTextMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarGetShowTextMethodInfo a signature where
    overloadedMethod = progressBarGetShowText

#endif

-- method ProgressBar::get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_get_text" gtk_progress_bar_get_text :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO CString

-- | Retrieves the text that is displayed with the progress bar,
-- if any, otherwise 'P.Nothing'. The return value is a reference
-- to the text, not a copy of it, so will become invalid
-- if you change the text in the progress bar.
progressBarGetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ text, or 'P.Nothing'; this string is owned by the widget
    -- and should not be modified or freed.
progressBarGetText :: a -> m (Maybe Text)
progressBarGetText a
pbar = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CString
result <- Ptr ProgressBar -> IO CString
gtk_progress_bar_get_text Ptr ProgressBar
pbar'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ProgressBarGetTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarGetTextMethodInfo a signature where
    overloadedMethod = progressBarGetText

#endif

-- method ProgressBar::pulse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_pulse" gtk_progress_bar_pulse :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    IO ()

-- | Indicates that some progress has been made, but you don’t know how much.
-- Causes the progress bar to enter “activity mode,” where a block
-- bounces back and forth. Each call to 'GI.Gtk.Objects.ProgressBar.progressBarPulse'
-- causes the block to move by a little bit (the amount of movement
-- per pulse is determined by 'GI.Gtk.Objects.ProgressBar.progressBarSetPulseStep').
progressBarPulse ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> m ()
progressBarPulse :: a -> m ()
progressBarPulse a
pbar = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    Ptr ProgressBar -> IO ()
gtk_progress_bar_pulse Ptr ProgressBar
pbar'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarPulseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarPulseMethodInfo a signature where
    overloadedMethod = progressBarPulse

#endif

-- method ProgressBar::set_ellipsize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Pango" , name = "EllipsizeMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #PangoEllipsizeMode"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_set_ellipsize" gtk_progress_bar_set_ellipsize :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "Pango", name = "EllipsizeMode"})
    IO ()

-- | Sets the mode used to ellipsize (add an ellipsis: \"...\") the
-- text if there is not enough space to render the entire string.
progressBarSetEllipsize ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> Pango.Enums.EllipsizeMode
    -- ^ /@mode@/: a t'GI.Pango.Enums.EllipsizeMode'
    -> m ()
progressBarSetEllipsize :: a -> EllipsizeMode -> m ()
progressBarSetEllipsize a
pbar EllipsizeMode
mode = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (EllipsizeMode -> Int) -> EllipsizeMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EllipsizeMode -> Int
forall a. Enum a => a -> Int
fromEnum) EllipsizeMode
mode
    Ptr ProgressBar -> CUInt -> IO ()
gtk_progress_bar_set_ellipsize Ptr ProgressBar
pbar' CUInt
mode'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarSetEllipsizeMethodInfo
instance (signature ~ (Pango.Enums.EllipsizeMode -> m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarSetEllipsizeMethodInfo a signature where
    overloadedMethod = progressBarSetEllipsize

#endif

-- method ProgressBar::set_fraction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fraction"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "fraction of the task that\8217s been completed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_set_fraction" gtk_progress_bar_set_fraction :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    CDouble ->                              -- fraction : TBasicType TDouble
    IO ()

-- | Causes the progress bar to “fill in” the given fraction
-- of the bar. The fraction should be between 0.0 and 1.0,
-- inclusive.
progressBarSetFraction ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> Double
    -- ^ /@fraction@/: fraction of the task that’s been completed
    -> m ()
progressBarSetFraction :: a -> Double -> m ()
progressBarSetFraction a
pbar Double
fraction = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    let fraction' :: CDouble
fraction' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fraction
    Ptr ProgressBar -> CDouble -> IO ()
gtk_progress_bar_set_fraction Ptr ProgressBar
pbar' CDouble
fraction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarSetFractionMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarSetFractionMethodInfo a signature where
    overloadedMethod = progressBarSetFraction

#endif

-- method ProgressBar::set_inverted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "inverted"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE to invert the progress bar"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_set_inverted" gtk_progress_bar_set_inverted :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    CInt ->                                 -- inverted : TBasicType TBoolean
    IO ()

-- | Progress bars normally grow from top to bottom or left to right.
-- Inverted progress bars grow in the opposite direction.
progressBarSetInverted ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> Bool
    -- ^ /@inverted@/: 'P.True' to invert the progress bar
    -> m ()
progressBarSetInverted :: a -> Bool -> m ()
progressBarSetInverted a
pbar Bool
inverted = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    let inverted' :: CInt
inverted' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
inverted
    Ptr ProgressBar -> CInt -> IO ()
gtk_progress_bar_set_inverted Ptr ProgressBar
pbar' CInt
inverted'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarSetInvertedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarSetInvertedMethodInfo a signature where
    overloadedMethod = progressBarSetInverted

#endif

-- method ProgressBar::set_pulse_step
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fraction"
--           , argType = TBasicType TDouble
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "fraction between 0.0 and 1.0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_set_pulse_step" gtk_progress_bar_set_pulse_step :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    CDouble ->                              -- fraction : TBasicType TDouble
    IO ()

-- | Sets the fraction of total progress bar length to move the
-- bouncing block for each call to 'GI.Gtk.Objects.ProgressBar.progressBarPulse'.
progressBarSetPulseStep ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> Double
    -- ^ /@fraction@/: fraction between 0.0 and 1.0
    -> m ()
progressBarSetPulseStep :: a -> Double -> m ()
progressBarSetPulseStep a
pbar Double
fraction = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    let fraction' :: CDouble
fraction' = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
fraction
    Ptr ProgressBar -> CDouble -> IO ()
gtk_progress_bar_set_pulse_step Ptr ProgressBar
pbar' CDouble
fraction'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarSetPulseStepMethodInfo
instance (signature ~ (Double -> m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarSetPulseStepMethodInfo a signature where
    overloadedMethod = progressBarSetPulseStep

#endif

-- method ProgressBar::set_show_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "show_text"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to show text"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_set_show_text" gtk_progress_bar_set_show_text :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    CInt ->                                 -- show_text : TBasicType TBoolean
    IO ()

-- | Sets whether the progress bar will show text next to the bar.
-- The shown text is either the value of the t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/text/@
-- property or, if that is 'P.Nothing', the t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/fraction/@ value,
-- as a percentage.
-- 
-- To make a progress bar that is styled and sized suitably for containing
-- text (even if the actual text is blank), set t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/show-text/@ to
-- 'P.True' and t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/text/@ to the empty string (not 'P.Nothing').
progressBarSetShowText ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> Bool
    -- ^ /@showText@/: whether to show text
    -> m ()
progressBarSetShowText :: a -> Bool -> m ()
progressBarSetShowText a
pbar Bool
showText = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    let showText' :: CInt
showText' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
showText
    Ptr ProgressBar -> CInt -> IO ()
gtk_progress_bar_set_show_text Ptr ProgressBar
pbar' CInt
showText'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarSetShowTextMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarSetShowTextMethodInfo a signature where
    overloadedMethod = progressBarSetShowText

#endif

-- method ProgressBar::set_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "pbar"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "ProgressBar" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkProgressBar" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a UTF-8 string, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_progress_bar_set_text" gtk_progress_bar_set_text :: 
    Ptr ProgressBar ->                      -- pbar : TInterface (Name {namespace = "Gtk", name = "ProgressBar"})
    CString ->                              -- text : TBasicType TUTF8
    IO ()

-- | Causes the given /@text@/ to appear next to the progress bar.
-- 
-- If /@text@/ is 'P.Nothing' and t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/show-text/@ is 'P.True', the current
-- value of t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/fraction/@ will be displayed as a percentage.
-- 
-- If /@text@/ is non-'P.Nothing' and t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/show-text/@ is 'P.True', the text
-- will be displayed. In this case, it will not display the progress
-- percentage. If /@text@/ is the empty string, the progress bar will still
-- be styled and sized suitably for containing text, as long as
-- t'GI.Gtk.Objects.ProgressBar.ProgressBar':@/show-text/@ is 'P.True'.
progressBarSetText ::
    (B.CallStack.HasCallStack, MonadIO m, IsProgressBar a) =>
    a
    -- ^ /@pbar@/: a t'GI.Gtk.Objects.ProgressBar.ProgressBar'
    -> Maybe (T.Text)
    -- ^ /@text@/: a UTF-8 string, or 'P.Nothing'
    -> m ()
progressBarSetText :: a -> Maybe Text -> m ()
progressBarSetText a
pbar Maybe Text
text = 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 ProgressBar
pbar' <- a -> IO (Ptr ProgressBar)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
pbar
    CString
maybeText <- case Maybe Text
text of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jText -> do
            CString
jText' <- Text -> IO CString
textToCString Text
jText
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jText'
    Ptr ProgressBar -> CString -> IO ()
gtk_progress_bar_set_text Ptr ProgressBar
pbar' CString
maybeText
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
pbar
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeText
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ProgressBarSetTextMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsProgressBar a) => O.MethodInfo ProgressBarSetTextMethodInfo a signature where
    overloadedMethod = progressBarSetText

#endif