{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An adaptive container acting like a box or an overlay.
-- 
-- \<picture>
--   \<source srcset=\"flap-wide-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"flap-wide.png\" alt=\"flap-wide\">
-- \<\/picture>
-- \<picture>
--   \<source srcset=\"flap-narrow-dark.png\" media=\"(prefers-color-scheme: dark)\">
--   \<img src=\"flap-narrow.png\" alt=\"flap-narrow\">
-- \<\/picture>
-- 
-- The @AdwFlap@ widget can display its children like a t'GI.Gtk.Objects.Box.Box' does or
-- like a t'GI.Gtk.Objects.Overlay.Overlay' does, according to the
-- [property/@flap@/:fold-policy] value.
-- 
-- @AdwFlap@ has at most three children: [property/@flap@/:content],
-- [property/@flap@/:flap] and [property/@flap@/:separator]. Content is the primary
-- child, flap is displayed next to it when unfolded, or overlays it when
-- folded. Flap can be shown or hidden by changing the
-- [property/@flap@/:reveal-flap] value, as well as via swipe gestures if
-- [property/@flap@/:swipe-to-open] and\/or [property/@flap@/:swipe-to-close] are set
-- to @TRUE@.
-- 
-- Optionally, a separator can be provided, which would be displayed between
-- the content and the flap when there\'s no shadow to separate them, depending
-- on the transition type.
-- 
-- [property/@flap@/:flap] is transparent by default; add the
-- <https://gnome.pages.gitlab.gnome.org/libadwaita/doc/main/style-classes.html#background `.background`> style class to it if this is
-- unwanted.
-- 
-- If [property/@flap@/:modal] is set to @TRUE@, content becomes completely
-- inaccessible when the flap is revealed while folded.
-- 
-- The position of the flap and separator children relative to the content is
-- determined by orientation, as well as the [property/@flap@/:flap-position]
-- value.
-- 
-- Folding the flap will automatically hide the flap widget, and unfolding it
-- will automatically reveal it. If this behavior is not desired, the
-- [property/@flap@/:locked] property can be used to override it.
-- 
-- Common use cases include sidebars, header bars that need to be able to
-- overlap the window content (for example, in fullscreen mode) and bottom
-- sheets.
-- 
-- == AdwFlap as GtkBuildable
-- 
-- The @AdwFlap@ implementation of the t'GI.Gtk.Interfaces.Buildable.Buildable' interface supports
-- setting the flap child by specifying “flap” as the “type” attribute of a
-- @\<child>@ element, and separator by specifying “separator”. Specifying
-- “content” child type or omitting it results in setting the content child.
-- 
-- == CSS nodes
-- 
-- @AdwFlap@ has a single CSS node with name @flap@. The node will get the style
-- classes @.folded@ when it is folded, and @.unfolded@ when it\'s not.

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

module GI.Adw.Objects.Flap
    ( 

-- * Exported types
    Flap(..)                                ,
    IsFlap                                  ,
    toFlap                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionSetEnabled]("GI.Gtk.Objects.Widget#g:method:actionSetEnabled"), [activate]("GI.Gtk.Objects.Widget#g:method:activate"), [activateAction]("GI.Gtk.Objects.Widget#g:method:activateAction"), [activateDefault]("GI.Gtk.Objects.Widget#g:method:activateDefault"), [addController]("GI.Gtk.Objects.Widget#g:method:addController"), [addCssClass]("GI.Gtk.Objects.Widget#g:method:addCssClass"), [addMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:addMnemonicLabel"), [addTickCallback]("GI.Gtk.Objects.Widget#g:method:addTickCallback"), [allocate]("GI.Gtk.Objects.Widget#g:method:allocate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [childFocus]("GI.Gtk.Objects.Widget#g:method:childFocus"), [computeBounds]("GI.Gtk.Objects.Widget#g:method:computeBounds"), [computeExpand]("GI.Gtk.Objects.Widget#g:method:computeExpand"), [computePoint]("GI.Gtk.Objects.Widget#g:method:computePoint"), [computeTransform]("GI.Gtk.Objects.Widget#g:method:computeTransform"), [contains]("GI.Gtk.Objects.Widget#g:method:contains"), [createPangoContext]("GI.Gtk.Objects.Widget#g:method:createPangoContext"), [createPangoLayout]("GI.Gtk.Objects.Widget#g:method:createPangoLayout"), [disposeTemplate]("GI.Gtk.Objects.Widget#g:method:disposeTemplate"), [dragCheckThreshold]("GI.Gtk.Objects.Widget#g:method:dragCheckThreshold"), [errorBell]("GI.Gtk.Objects.Widget#g:method:errorBell"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [grabFocus]("GI.Gtk.Objects.Widget#g:method:grabFocus"), [hasCssClass]("GI.Gtk.Objects.Widget#g:method:hasCssClass"), [hasDefault]("GI.Gtk.Objects.Widget#g:method:hasDefault"), [hasFocus]("GI.Gtk.Objects.Widget#g:method:hasFocus"), [hasVisibleFocus]("GI.Gtk.Objects.Widget#g:method:hasVisibleFocus"), [hide]("GI.Gtk.Objects.Widget#g:method:hide"), [inDestruction]("GI.Gtk.Objects.Widget#g:method:inDestruction"), [initTemplate]("GI.Gtk.Objects.Widget#g:method:initTemplate"), [insertActionGroup]("GI.Gtk.Objects.Widget#g:method:insertActionGroup"), [insertAfter]("GI.Gtk.Objects.Widget#g:method:insertAfter"), [insertBefore]("GI.Gtk.Objects.Widget#g:method:insertBefore"), [isAncestor]("GI.Gtk.Objects.Widget#g:method:isAncestor"), [isDrawable]("GI.Gtk.Objects.Widget#g:method:isDrawable"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isFocus]("GI.Gtk.Objects.Widget#g:method:isFocus"), [isSensitive]("GI.Gtk.Objects.Widget#g:method:isSensitive"), [isVisible]("GI.Gtk.Objects.Widget#g:method:isVisible"), [keynavFailed]("GI.Gtk.Objects.Widget#g:method:keynavFailed"), [listMnemonicLabels]("GI.Gtk.Objects.Widget#g:method:listMnemonicLabels"), [map]("GI.Gtk.Objects.Widget#g:method:map"), [measure]("GI.Gtk.Objects.Widget#g:method:measure"), [mnemonicActivate]("GI.Gtk.Objects.Widget#g:method:mnemonicActivate"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [observeChildren]("GI.Gtk.Objects.Widget#g:method:observeChildren"), [observeControllers]("GI.Gtk.Objects.Widget#g:method:observeControllers"), [pick]("GI.Gtk.Objects.Widget#g:method:pick"), [queueAllocate]("GI.Gtk.Objects.Widget#g:method:queueAllocate"), [queueDraw]("GI.Gtk.Objects.Widget#g:method:queueDraw"), [queueResize]("GI.Gtk.Objects.Widget#g:method:queueResize"), [realize]("GI.Gtk.Objects.Widget#g:method:realize"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeController]("GI.Gtk.Objects.Widget#g:method:removeController"), [removeCssClass]("GI.Gtk.Objects.Widget#g:method:removeCssClass"), [removeMnemonicLabel]("GI.Gtk.Objects.Widget#g:method:removeMnemonicLabel"), [removeTickCallback]("GI.Gtk.Objects.Widget#g:method:removeTickCallback"), [resetProperty]("GI.Gtk.Interfaces.Accessible#g:method:resetProperty"), [resetRelation]("GI.Gtk.Interfaces.Accessible#g:method:resetRelation"), [resetState]("GI.Gtk.Interfaces.Accessible#g:method:resetState"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [shouldLayout]("GI.Gtk.Objects.Widget#g:method:shouldLayout"), [show]("GI.Gtk.Objects.Widget#g:method:show"), [sizeAllocate]("GI.Gtk.Objects.Widget#g:method:sizeAllocate"), [snapshotChild]("GI.Gtk.Objects.Widget#g:method:snapshotChild"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [translateCoordinates]("GI.Gtk.Objects.Widget#g:method:translateCoordinates"), [triggerTooltipQuery]("GI.Gtk.Objects.Widget#g:method:triggerTooltipQuery"), [unmap]("GI.Gtk.Objects.Widget#g:method:unmap"), [unparent]("GI.Gtk.Objects.Widget#g:method:unparent"), [unrealize]("GI.Gtk.Objects.Widget#g:method:unrealize"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unsetStateFlags]("GI.Gtk.Objects.Widget#g:method:unsetStateFlags"), [updateNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:updateNextAccessibleSibling"), [updateProperty]("GI.Gtk.Interfaces.Accessible#g:method:updateProperty"), [updateRelation]("GI.Gtk.Interfaces.Accessible#g:method:updateRelation"), [updateState]("GI.Gtk.Interfaces.Accessible#g:method:updateState"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleParent"), [getAccessibleRole]("GI.Gtk.Interfaces.Accessible#g:method:getAccessibleRole"), [getAllocatedBaseline]("GI.Gtk.Objects.Widget#g:method:getAllocatedBaseline"), [getAllocatedHeight]("GI.Gtk.Objects.Widget#g:method:getAllocatedHeight"), [getAllocatedWidth]("GI.Gtk.Objects.Widget#g:method:getAllocatedWidth"), [getAllocation]("GI.Gtk.Objects.Widget#g:method:getAllocation"), [getAncestor]("GI.Gtk.Objects.Widget#g:method:getAncestor"), [getAtContext]("GI.Gtk.Interfaces.Accessible#g:method:getAtContext"), [getBounds]("GI.Gtk.Interfaces.Accessible#g:method:getBounds"), [getBuildableId]("GI.Gtk.Interfaces.Buildable#g:method:getBuildableId"), [getCanFocus]("GI.Gtk.Objects.Widget#g:method:getCanFocus"), [getCanTarget]("GI.Gtk.Objects.Widget#g:method:getCanTarget"), [getCancelProgress]("GI.Adw.Interfaces.Swipeable#g:method:getCancelProgress"), [getChildVisible]("GI.Gtk.Objects.Widget#g:method:getChildVisible"), [getClipboard]("GI.Gtk.Objects.Widget#g:method:getClipboard"), [getColor]("GI.Gtk.Objects.Widget#g:method:getColor"), [getContent]("GI.Adw.Objects.Flap#g:method:getContent"), [getCssClasses]("GI.Gtk.Objects.Widget#g:method:getCssClasses"), [getCssName]("GI.Gtk.Objects.Widget#g:method:getCssName"), [getCursor]("GI.Gtk.Objects.Widget#g:method:getCursor"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDirection]("GI.Gtk.Objects.Widget#g:method:getDirection"), [getDisplay]("GI.Gtk.Objects.Widget#g:method:getDisplay"), [getDistance]("GI.Adw.Interfaces.Swipeable#g:method:getDistance"), [getFirstAccessibleChild]("GI.Gtk.Interfaces.Accessible#g:method:getFirstAccessibleChild"), [getFirstChild]("GI.Gtk.Objects.Widget#g:method:getFirstChild"), [getFlap]("GI.Adw.Objects.Flap#g:method:getFlap"), [getFlapPosition]("GI.Adw.Objects.Flap#g:method:getFlapPosition"), [getFocusChild]("GI.Gtk.Objects.Widget#g:method:getFocusChild"), [getFocusOnClick]("GI.Gtk.Objects.Widget#g:method:getFocusOnClick"), [getFocusable]("GI.Gtk.Objects.Widget#g:method:getFocusable"), [getFoldDuration]("GI.Adw.Objects.Flap#g:method:getFoldDuration"), [getFoldPolicy]("GI.Adw.Objects.Flap#g:method:getFoldPolicy"), [getFoldThresholdPolicy]("GI.Adw.Objects.Flap#g:method:getFoldThresholdPolicy"), [getFolded]("GI.Adw.Objects.Flap#g:method:getFolded"), [getFontMap]("GI.Gtk.Objects.Widget#g:method:getFontMap"), [getFontOptions]("GI.Gtk.Objects.Widget#g:method:getFontOptions"), [getFrameClock]("GI.Gtk.Objects.Widget#g:method:getFrameClock"), [getHalign]("GI.Gtk.Objects.Widget#g:method:getHalign"), [getHasTooltip]("GI.Gtk.Objects.Widget#g:method:getHasTooltip"), [getHeight]("GI.Gtk.Objects.Widget#g:method:getHeight"), [getHexpand]("GI.Gtk.Objects.Widget#g:method:getHexpand"), [getHexpandSet]("GI.Gtk.Objects.Widget#g:method:getHexpandSet"), [getLastChild]("GI.Gtk.Objects.Widget#g:method:getLastChild"), [getLayoutManager]("GI.Gtk.Objects.Widget#g:method:getLayoutManager"), [getLocked]("GI.Adw.Objects.Flap#g:method:getLocked"), [getMapped]("GI.Gtk.Objects.Widget#g:method:getMapped"), [getMarginBottom]("GI.Gtk.Objects.Widget#g:method:getMarginBottom"), [getMarginEnd]("GI.Gtk.Objects.Widget#g:method:getMarginEnd"), [getMarginStart]("GI.Gtk.Objects.Widget#g:method:getMarginStart"), [getMarginTop]("GI.Gtk.Objects.Widget#g:method:getMarginTop"), [getModal]("GI.Adw.Objects.Flap#g:method:getModal"), [getName]("GI.Gtk.Objects.Widget#g:method:getName"), [getNative]("GI.Gtk.Objects.Widget#g:method:getNative"), [getNextAccessibleSibling]("GI.Gtk.Interfaces.Accessible#g:method:getNextAccessibleSibling"), [getNextSibling]("GI.Gtk.Objects.Widget#g:method:getNextSibling"), [getOpacity]("GI.Gtk.Objects.Widget#g:method:getOpacity"), [getOrientation]("GI.Gtk.Interfaces.Orientable#g:method:getOrientation"), [getOverflow]("GI.Gtk.Objects.Widget#g:method:getOverflow"), [getPangoContext]("GI.Gtk.Objects.Widget#g:method:getPangoContext"), [getParent]("GI.Gtk.Objects.Widget#g:method:getParent"), [getPlatformState]("GI.Gtk.Interfaces.Accessible#g:method:getPlatformState"), [getPreferredSize]("GI.Gtk.Objects.Widget#g:method:getPreferredSize"), [getPrevSibling]("GI.Gtk.Objects.Widget#g:method:getPrevSibling"), [getPrimaryClipboard]("GI.Gtk.Objects.Widget#g:method:getPrimaryClipboard"), [getProgress]("GI.Adw.Interfaces.Swipeable#g:method:getProgress"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealized]("GI.Gtk.Objects.Widget#g:method:getRealized"), [getReceivesDefault]("GI.Gtk.Objects.Widget#g:method:getReceivesDefault"), [getRequestMode]("GI.Gtk.Objects.Widget#g:method:getRequestMode"), [getRevealFlap]("GI.Adw.Objects.Flap#g:method:getRevealFlap"), [getRevealParams]("GI.Adw.Objects.Flap#g:method:getRevealParams"), [getRevealProgress]("GI.Adw.Objects.Flap#g:method:getRevealProgress"), [getRoot]("GI.Gtk.Objects.Widget#g:method:getRoot"), [getScaleFactor]("GI.Gtk.Objects.Widget#g:method:getScaleFactor"), [getSensitive]("GI.Gtk.Objects.Widget#g:method:getSensitive"), [getSeparator]("GI.Adw.Objects.Flap#g:method:getSeparator"), [getSettings]("GI.Gtk.Objects.Widget#g:method:getSettings"), [getSize]("GI.Gtk.Objects.Widget#g:method:getSize"), [getSizeRequest]("GI.Gtk.Objects.Widget#g:method:getSizeRequest"), [getSnapPoints]("GI.Adw.Interfaces.Swipeable#g:method:getSnapPoints"), [getStateFlags]("GI.Gtk.Objects.Widget#g:method:getStateFlags"), [getStyleContext]("GI.Gtk.Objects.Widget#g:method:getStyleContext"), [getSwipeArea]("GI.Adw.Interfaces.Swipeable#g:method:getSwipeArea"), [getSwipeToClose]("GI.Adw.Objects.Flap#g:method:getSwipeToClose"), [getSwipeToOpen]("GI.Adw.Objects.Flap#g:method:getSwipeToOpen"), [getTemplateChild]("GI.Gtk.Objects.Widget#g:method:getTemplateChild"), [getTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:getTooltipMarkup"), [getTooltipText]("GI.Gtk.Objects.Widget#g:method:getTooltipText"), [getTransitionType]("GI.Adw.Objects.Flap#g:method:getTransitionType"), [getValign]("GI.Gtk.Objects.Widget#g:method:getValign"), [getVexpand]("GI.Gtk.Objects.Widget#g:method:getVexpand"), [getVexpandSet]("GI.Gtk.Objects.Widget#g:method:getVexpandSet"), [getVisible]("GI.Gtk.Objects.Widget#g:method:getVisible"), [getWidth]("GI.Gtk.Objects.Widget#g:method:getWidth").
-- 
-- ==== Setters
-- [setAccessibleParent]("GI.Gtk.Interfaces.Accessible#g:method:setAccessibleParent"), [setCanFocus]("GI.Gtk.Objects.Widget#g:method:setCanFocus"), [setCanTarget]("GI.Gtk.Objects.Widget#g:method:setCanTarget"), [setChildVisible]("GI.Gtk.Objects.Widget#g:method:setChildVisible"), [setContent]("GI.Adw.Objects.Flap#g:method:setContent"), [setCssClasses]("GI.Gtk.Objects.Widget#g:method:setCssClasses"), [setCursor]("GI.Gtk.Objects.Widget#g:method:setCursor"), [setCursorFromName]("GI.Gtk.Objects.Widget#g:method:setCursorFromName"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDirection]("GI.Gtk.Objects.Widget#g:method:setDirection"), [setFlap]("GI.Adw.Objects.Flap#g:method:setFlap"), [setFlapPosition]("GI.Adw.Objects.Flap#g:method:setFlapPosition"), [setFocusChild]("GI.Gtk.Objects.Widget#g:method:setFocusChild"), [setFocusOnClick]("GI.Gtk.Objects.Widget#g:method:setFocusOnClick"), [setFocusable]("GI.Gtk.Objects.Widget#g:method:setFocusable"), [setFoldDuration]("GI.Adw.Objects.Flap#g:method:setFoldDuration"), [setFoldPolicy]("GI.Adw.Objects.Flap#g:method:setFoldPolicy"), [setFoldThresholdPolicy]("GI.Adw.Objects.Flap#g:method:setFoldThresholdPolicy"), [setFontMap]("GI.Gtk.Objects.Widget#g:method:setFontMap"), [setFontOptions]("GI.Gtk.Objects.Widget#g:method:setFontOptions"), [setHalign]("GI.Gtk.Objects.Widget#g:method:setHalign"), [setHasTooltip]("GI.Gtk.Objects.Widget#g:method:setHasTooltip"), [setHexpand]("GI.Gtk.Objects.Widget#g:method:setHexpand"), [setHexpandSet]("GI.Gtk.Objects.Widget#g:method:setHexpandSet"), [setLayoutManager]("GI.Gtk.Objects.Widget#g:method:setLayoutManager"), [setLocked]("GI.Adw.Objects.Flap#g:method:setLocked"), [setMarginBottom]("GI.Gtk.Objects.Widget#g:method:setMarginBottom"), [setMarginEnd]("GI.Gtk.Objects.Widget#g:method:setMarginEnd"), [setMarginStart]("GI.Gtk.Objects.Widget#g:method:setMarginStart"), [setMarginTop]("GI.Gtk.Objects.Widget#g:method:setMarginTop"), [setModal]("GI.Adw.Objects.Flap#g:method:setModal"), [setName]("GI.Gtk.Objects.Widget#g:method:setName"), [setOpacity]("GI.Gtk.Objects.Widget#g:method:setOpacity"), [setOrientation]("GI.Gtk.Interfaces.Orientable#g:method:setOrientation"), [setOverflow]("GI.Gtk.Objects.Widget#g:method:setOverflow"), [setParent]("GI.Gtk.Objects.Widget#g:method:setParent"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setReceivesDefault]("GI.Gtk.Objects.Widget#g:method:setReceivesDefault"), [setRevealFlap]("GI.Adw.Objects.Flap#g:method:setRevealFlap"), [setRevealParams]("GI.Adw.Objects.Flap#g:method:setRevealParams"), [setSensitive]("GI.Gtk.Objects.Widget#g:method:setSensitive"), [setSeparator]("GI.Adw.Objects.Flap#g:method:setSeparator"), [setSizeRequest]("GI.Gtk.Objects.Widget#g:method:setSizeRequest"), [setStateFlags]("GI.Gtk.Objects.Widget#g:method:setStateFlags"), [setSwipeToClose]("GI.Adw.Objects.Flap#g:method:setSwipeToClose"), [setSwipeToOpen]("GI.Adw.Objects.Flap#g:method:setSwipeToOpen"), [setTooltipMarkup]("GI.Gtk.Objects.Widget#g:method:setTooltipMarkup"), [setTooltipText]("GI.Gtk.Objects.Widget#g:method:setTooltipText"), [setTransitionType]("GI.Adw.Objects.Flap#g:method:setTransitionType"), [setValign]("GI.Gtk.Objects.Widget#g:method:setValign"), [setVexpand]("GI.Gtk.Objects.Widget#g:method:setVexpand"), [setVexpandSet]("GI.Gtk.Objects.Widget#g:method:setVexpandSet"), [setVisible]("GI.Gtk.Objects.Widget#g:method:setVisible").

#if defined(ENABLE_OVERLOADING)
    ResolveFlapMethod                       ,
#endif

-- ** getContent #method:getContent#

#if defined(ENABLE_OVERLOADING)
    FlapGetContentMethodInfo                ,
#endif
    flapGetContent                          ,


-- ** getFlap #method:getFlap#

#if defined(ENABLE_OVERLOADING)
    FlapGetFlapMethodInfo                   ,
#endif
    flapGetFlap                             ,


-- ** getFlapPosition #method:getFlapPosition#

#if defined(ENABLE_OVERLOADING)
    FlapGetFlapPositionMethodInfo           ,
#endif
    flapGetFlapPosition                     ,


-- ** getFoldDuration #method:getFoldDuration#

#if defined(ENABLE_OVERLOADING)
    FlapGetFoldDurationMethodInfo           ,
#endif
    flapGetFoldDuration                     ,


-- ** getFoldPolicy #method:getFoldPolicy#

#if defined(ENABLE_OVERLOADING)
    FlapGetFoldPolicyMethodInfo             ,
#endif
    flapGetFoldPolicy                       ,


-- ** getFoldThresholdPolicy #method:getFoldThresholdPolicy#

#if defined(ENABLE_OVERLOADING)
    FlapGetFoldThresholdPolicyMethodInfo    ,
#endif
    flapGetFoldThresholdPolicy              ,


-- ** getFolded #method:getFolded#

#if defined(ENABLE_OVERLOADING)
    FlapGetFoldedMethodInfo                 ,
#endif
    flapGetFolded                           ,


-- ** getLocked #method:getLocked#

#if defined(ENABLE_OVERLOADING)
    FlapGetLockedMethodInfo                 ,
#endif
    flapGetLocked                           ,


-- ** getModal #method:getModal#

#if defined(ENABLE_OVERLOADING)
    FlapGetModalMethodInfo                  ,
#endif
    flapGetModal                            ,


-- ** getRevealFlap #method:getRevealFlap#

#if defined(ENABLE_OVERLOADING)
    FlapGetRevealFlapMethodInfo             ,
#endif
    flapGetRevealFlap                       ,


-- ** getRevealParams #method:getRevealParams#

#if defined(ENABLE_OVERLOADING)
    FlapGetRevealParamsMethodInfo           ,
#endif
    flapGetRevealParams                     ,


-- ** getRevealProgress #method:getRevealProgress#

#if defined(ENABLE_OVERLOADING)
    FlapGetRevealProgressMethodInfo         ,
#endif
    flapGetRevealProgress                   ,


-- ** getSeparator #method:getSeparator#

#if defined(ENABLE_OVERLOADING)
    FlapGetSeparatorMethodInfo              ,
#endif
    flapGetSeparator                        ,


-- ** getSwipeToClose #method:getSwipeToClose#

#if defined(ENABLE_OVERLOADING)
    FlapGetSwipeToCloseMethodInfo           ,
#endif
    flapGetSwipeToClose                     ,


-- ** getSwipeToOpen #method:getSwipeToOpen#

#if defined(ENABLE_OVERLOADING)
    FlapGetSwipeToOpenMethodInfo            ,
#endif
    flapGetSwipeToOpen                      ,


-- ** getTransitionType #method:getTransitionType#

#if defined(ENABLE_OVERLOADING)
    FlapGetTransitionTypeMethodInfo         ,
#endif
    flapGetTransitionType                   ,


-- ** new #method:new#

    flapNew                                 ,


-- ** setContent #method:setContent#

#if defined(ENABLE_OVERLOADING)
    FlapSetContentMethodInfo                ,
#endif
    flapSetContent                          ,


-- ** setFlap #method:setFlap#

#if defined(ENABLE_OVERLOADING)
    FlapSetFlapMethodInfo                   ,
#endif
    flapSetFlap                             ,


-- ** setFlapPosition #method:setFlapPosition#

#if defined(ENABLE_OVERLOADING)
    FlapSetFlapPositionMethodInfo           ,
#endif
    flapSetFlapPosition                     ,


-- ** setFoldDuration #method:setFoldDuration#

#if defined(ENABLE_OVERLOADING)
    FlapSetFoldDurationMethodInfo           ,
#endif
    flapSetFoldDuration                     ,


-- ** setFoldPolicy #method:setFoldPolicy#

#if defined(ENABLE_OVERLOADING)
    FlapSetFoldPolicyMethodInfo             ,
#endif
    flapSetFoldPolicy                       ,


-- ** setFoldThresholdPolicy #method:setFoldThresholdPolicy#

#if defined(ENABLE_OVERLOADING)
    FlapSetFoldThresholdPolicyMethodInfo    ,
#endif
    flapSetFoldThresholdPolicy              ,


-- ** setLocked #method:setLocked#

#if defined(ENABLE_OVERLOADING)
    FlapSetLockedMethodInfo                 ,
#endif
    flapSetLocked                           ,


-- ** setModal #method:setModal#

#if defined(ENABLE_OVERLOADING)
    FlapSetModalMethodInfo                  ,
#endif
    flapSetModal                            ,


-- ** setRevealFlap #method:setRevealFlap#

#if defined(ENABLE_OVERLOADING)
    FlapSetRevealFlapMethodInfo             ,
#endif
    flapSetRevealFlap                       ,


-- ** setRevealParams #method:setRevealParams#

#if defined(ENABLE_OVERLOADING)
    FlapSetRevealParamsMethodInfo           ,
#endif
    flapSetRevealParams                     ,


-- ** setSeparator #method:setSeparator#

#if defined(ENABLE_OVERLOADING)
    FlapSetSeparatorMethodInfo              ,
#endif
    flapSetSeparator                        ,


-- ** setSwipeToClose #method:setSwipeToClose#

#if defined(ENABLE_OVERLOADING)
    FlapSetSwipeToCloseMethodInfo           ,
#endif
    flapSetSwipeToClose                     ,


-- ** setSwipeToOpen #method:setSwipeToOpen#

#if defined(ENABLE_OVERLOADING)
    FlapSetSwipeToOpenMethodInfo            ,
#endif
    flapSetSwipeToOpen                      ,


-- ** setTransitionType #method:setTransitionType#

#if defined(ENABLE_OVERLOADING)
    FlapSetTransitionTypeMethodInfo         ,
#endif
    flapSetTransitionType                   ,




 -- * Properties


-- ** content #attr:content#
-- | The content widget.
-- 
-- It\'s always displayed when unfolded, and partially visible when folded.

#if defined(ENABLE_OVERLOADING)
    FlapContentPropertyInfo                 ,
#endif
    clearFlapContent                        ,
    constructFlapContent                    ,
#if defined(ENABLE_OVERLOADING)
    flapContent                             ,
#endif
    getFlapContent                          ,
    setFlapContent                          ,


-- ** flap #attr:flap#
-- | The flap widget.
-- 
-- It\'s only visible when [property/@flap@/:reveal-progress] is greater than 0.

#if defined(ENABLE_OVERLOADING)
    FlapFlapPropertyInfo                    ,
#endif
    clearFlapFlap                           ,
    constructFlapFlap                       ,
#if defined(ENABLE_OVERLOADING)
    flapFlap                                ,
#endif
    getFlapFlap                             ,
    setFlapFlap                             ,


-- ** flapPosition #attr:flapPosition#
-- | The flap position.
-- 
-- If it\'s set to @GTK_PACK_START@, the flap is displayed before the content,
-- if @GTK_PACK_END@, it\'s displayed after the content.

#if defined(ENABLE_OVERLOADING)
    FlapFlapPositionPropertyInfo            ,
#endif
    constructFlapFlapPosition               ,
#if defined(ENABLE_OVERLOADING)
    flapFlapPosition                        ,
#endif
    getFlapFlapPosition                     ,
    setFlapFlapPosition                     ,


-- ** foldDuration #attr:foldDuration#
-- | The fold transition animation duration, in milliseconds.

#if defined(ENABLE_OVERLOADING)
    FlapFoldDurationPropertyInfo            ,
#endif
    constructFlapFoldDuration               ,
#if defined(ENABLE_OVERLOADING)
    flapFoldDuration                        ,
#endif
    getFlapFoldDuration                     ,
    setFlapFoldDuration                     ,


-- ** foldPolicy #attr:foldPolicy#
-- | The fold policy for the flap.

#if defined(ENABLE_OVERLOADING)
    FlapFoldPolicyPropertyInfo              ,
#endif
    constructFlapFoldPolicy                 ,
#if defined(ENABLE_OVERLOADING)
    flapFoldPolicy                          ,
#endif
    getFlapFoldPolicy                       ,
    setFlapFoldPolicy                       ,


-- ** foldThresholdPolicy #attr:foldThresholdPolicy#
-- | Determines when the flap will fold.
-- 
-- If set to @ADW_FOLD_THRESHOLD_POLICY_MINIMUM@, flap will only fold when
-- the children cannot fit anymore. With @ADW_FOLD_THRESHOLD_POLICY_NATURAL@,
-- it will fold as soon as children don\'t get their natural size.
-- 
-- This can be useful if you have a long ellipsizing label and want to let it
-- ellipsize instead of immediately folding.

#if defined(ENABLE_OVERLOADING)
    FlapFoldThresholdPolicyPropertyInfo     ,
#endif
    constructFlapFoldThresholdPolicy        ,
#if defined(ENABLE_OVERLOADING)
    flapFoldThresholdPolicy                 ,
#endif
    getFlapFoldThresholdPolicy              ,
    setFlapFoldThresholdPolicy              ,


-- ** folded #attr:folded#
-- | Whether the flap is currently folded.
-- 
-- See [property/@flap@/:fold-policy].

#if defined(ENABLE_OVERLOADING)
    FlapFoldedPropertyInfo                  ,
#endif
#if defined(ENABLE_OVERLOADING)
    flapFolded                              ,
#endif
    getFlapFolded                           ,


-- ** locked #attr:locked#
-- | Whether the flap is locked.
-- 
-- If @FALSE@, folding when the flap is revealed automatically closes it, and
-- unfolding it when the flap is not revealed opens it. If @TRUE@,
-- [property/@flap@/:reveal-flap] value never changes on its own.

#if defined(ENABLE_OVERLOADING)
    FlapLockedPropertyInfo                  ,
#endif
    constructFlapLocked                     ,
#if defined(ENABLE_OVERLOADING)
    flapLocked                              ,
#endif
    getFlapLocked                           ,
    setFlapLocked                           ,


-- ** modal #attr:modal#
-- | Whether the flap is modal.
-- 
-- If @TRUE@, clicking the content widget while flap is revealed, as well as
-- pressing the \<kbd>Esc\<\/kbd> key, will close the flap. If @FALSE@, clicks
-- are passed through to the content widget.

#if defined(ENABLE_OVERLOADING)
    FlapModalPropertyInfo                   ,
#endif
    constructFlapModal                      ,
#if defined(ENABLE_OVERLOADING)
    flapModal                               ,
#endif
    getFlapModal                            ,
    setFlapModal                            ,


-- ** revealFlap #attr:revealFlap#
-- | Whether the flap widget is revealed.

#if defined(ENABLE_OVERLOADING)
    FlapRevealFlapPropertyInfo              ,
#endif
    constructFlapRevealFlap                 ,
#if defined(ENABLE_OVERLOADING)
    flapRevealFlap                          ,
#endif
    getFlapRevealFlap                       ,
    setFlapRevealFlap                       ,


-- ** revealParams #attr:revealParams#
-- | The reveal animation spring parameters.
-- 
-- The default value is equivalent to:
-- 
-- 
-- === /c code/
-- >adw_spring_params_new (1, 0.5, 500)

#if defined(ENABLE_OVERLOADING)
    FlapRevealParamsPropertyInfo            ,
#endif
    constructFlapRevealParams               ,
#if defined(ENABLE_OVERLOADING)
    flapRevealParams                        ,
#endif
    getFlapRevealParams                     ,
    setFlapRevealParams                     ,


-- ** revealProgress #attr:revealProgress#
-- | The current reveal transition progress.
-- 
-- 0 means fully hidden, 1 means fully revealed.
-- 
-- See [property/@flap@/:reveal-flap].

#if defined(ENABLE_OVERLOADING)
    FlapRevealProgressPropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    flapRevealProgress                      ,
#endif
    getFlapRevealProgress                   ,


-- ** separator #attr:separator#
-- | The separator widget.
-- 
-- It\'s displayed between content and flap when there\'s no shadow to display.
-- When exactly it\'s visible depends on the [property/@flap@/:transition-type]
-- value.

#if defined(ENABLE_OVERLOADING)
    FlapSeparatorPropertyInfo               ,
#endif
    clearFlapSeparator                      ,
    constructFlapSeparator                  ,
#if defined(ENABLE_OVERLOADING)
    flapSeparator                           ,
#endif
    getFlapSeparator                        ,
    setFlapSeparator                        ,


-- ** swipeToClose #attr:swipeToClose#
-- | Whether the flap can be closed with a swipe gesture.
-- 
-- The area that can be swiped depends on the [property/@flap@/:transition-type]
-- value.

#if defined(ENABLE_OVERLOADING)
    FlapSwipeToClosePropertyInfo            ,
#endif
    constructFlapSwipeToClose               ,
#if defined(ENABLE_OVERLOADING)
    flapSwipeToClose                        ,
#endif
    getFlapSwipeToClose                     ,
    setFlapSwipeToClose                     ,


-- ** swipeToOpen #attr:swipeToOpen#
-- | Whether the flap can be opened with a swipe gesture.
-- 
-- The area that can be swiped depends on the [property/@flap@/:transition-type]
-- value.

#if defined(ENABLE_OVERLOADING)
    FlapSwipeToOpenPropertyInfo             ,
#endif
    constructFlapSwipeToOpen                ,
#if defined(ENABLE_OVERLOADING)
    flapSwipeToOpen                         ,
#endif
    getFlapSwipeToOpen                      ,
    setFlapSwipeToOpen                      ,


-- ** transitionType #attr:transitionType#
-- | the type of animation used for reveal and fold transitions.
-- 
-- [property/@flap@/:flap] is transparent by default, which means the content
-- will be seen through it with @ADW_FLAP_TRANSITION_TYPE_OVER@ transitions;
-- add the <https://gnome.pages.gitlab.gnome.org/libadwaita/doc/main/style-classes.html#background `.background`> style class to it if
-- this is unwanted.

#if defined(ENABLE_OVERLOADING)
    FlapTransitionTypePropertyInfo          ,
#endif
    constructFlapTransitionType             ,
#if defined(ENABLE_OVERLOADING)
    flapTransitionType                      ,
#endif
    getFlapTransitionType                   ,
    setFlapTransitionType                   ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import {-# SOURCE #-} qualified GI.Adw.Interfaces.Swipeable as Adw.Swipeable
import {-# SOURCE #-} qualified GI.Adw.Structs.SpringParams as Adw.SpringParams
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Enums as Gtk.Enums
import qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Interfaces.Orientable as Gtk.Orientable
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

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

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

foreign import ccall "adw_flap_get_type"
    c_adw_flap_get_type :: IO B.Types.GType

instance B.Types.TypedObject Flap where
    glibType :: IO GType
glibType = IO GType
c_adw_flap_get_type

instance B.Types.GObject Flap

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

instance O.HasParentTypes Flap
type instance O.ParentTypes Flap = '[Gtk.Widget.Widget, GObject.Object.Object, Adw.Swipeable.Swipeable, Gtk.Accessible.Accessible, Gtk.Buildable.Buildable, Gtk.ConstraintTarget.ConstraintTarget, Gtk.Orientable.Orientable]

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

-- | Convert 'Flap' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Flap) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_adw_flap_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Flap -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Flap
P.Nothing = Ptr GValue -> Ptr Flap -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Flap
forall a. Ptr a
FP.nullPtr :: FP.Ptr Flap)
    gvalueSet_ Ptr GValue
gv (P.Just Flap
obj) = Flap -> (Ptr Flap -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Flap
obj (Ptr GValue -> Ptr Flap -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Flap)
gvalueGet_ Ptr GValue
gv = do
        Ptr Flap
ptr <- Ptr GValue -> IO (Ptr Flap)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Flap)
        if Ptr Flap
ptr Ptr Flap -> Ptr Flap -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Flap
forall a. Ptr a
FP.nullPtr
        then Flap -> Maybe Flap
forall a. a -> Maybe a
P.Just (Flap -> Maybe Flap) -> IO Flap -> IO (Maybe Flap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Flap -> Flap) -> Ptr Flap -> IO Flap
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Flap -> Flap
Flap Ptr Flap
ptr
        else Maybe Flap -> IO (Maybe Flap)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Flap
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveFlapMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFlapMethod "actionSetEnabled" o = Gtk.Widget.WidgetActionSetEnabledMethodInfo
    ResolveFlapMethod "activate" o = Gtk.Widget.WidgetActivateMethodInfo
    ResolveFlapMethod "activateAction" o = Gtk.Widget.WidgetActivateActionMethodInfo
    ResolveFlapMethod "activateDefault" o = Gtk.Widget.WidgetActivateDefaultMethodInfo
    ResolveFlapMethod "addController" o = Gtk.Widget.WidgetAddControllerMethodInfo
    ResolveFlapMethod "addCssClass" o = Gtk.Widget.WidgetAddCssClassMethodInfo
    ResolveFlapMethod "addMnemonicLabel" o = Gtk.Widget.WidgetAddMnemonicLabelMethodInfo
    ResolveFlapMethod "addTickCallback" o = Gtk.Widget.WidgetAddTickCallbackMethodInfo
    ResolveFlapMethod "allocate" o = Gtk.Widget.WidgetAllocateMethodInfo
    ResolveFlapMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFlapMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFlapMethod "childFocus" o = Gtk.Widget.WidgetChildFocusMethodInfo
    ResolveFlapMethod "computeBounds" o = Gtk.Widget.WidgetComputeBoundsMethodInfo
    ResolveFlapMethod "computeExpand" o = Gtk.Widget.WidgetComputeExpandMethodInfo
    ResolveFlapMethod "computePoint" o = Gtk.Widget.WidgetComputePointMethodInfo
    ResolveFlapMethod "computeTransform" o = Gtk.Widget.WidgetComputeTransformMethodInfo
    ResolveFlapMethod "contains" o = Gtk.Widget.WidgetContainsMethodInfo
    ResolveFlapMethod "createPangoContext" o = Gtk.Widget.WidgetCreatePangoContextMethodInfo
    ResolveFlapMethod "createPangoLayout" o = Gtk.Widget.WidgetCreatePangoLayoutMethodInfo
    ResolveFlapMethod "disposeTemplate" o = Gtk.Widget.WidgetDisposeTemplateMethodInfo
    ResolveFlapMethod "dragCheckThreshold" o = Gtk.Widget.WidgetDragCheckThresholdMethodInfo
    ResolveFlapMethod "errorBell" o = Gtk.Widget.WidgetErrorBellMethodInfo
    ResolveFlapMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFlapMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFlapMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFlapMethod "grabFocus" o = Gtk.Widget.WidgetGrabFocusMethodInfo
    ResolveFlapMethod "hasCssClass" o = Gtk.Widget.WidgetHasCssClassMethodInfo
    ResolveFlapMethod "hasDefault" o = Gtk.Widget.WidgetHasDefaultMethodInfo
    ResolveFlapMethod "hasFocus" o = Gtk.Widget.WidgetHasFocusMethodInfo
    ResolveFlapMethod "hasVisibleFocus" o = Gtk.Widget.WidgetHasVisibleFocusMethodInfo
    ResolveFlapMethod "hide" o = Gtk.Widget.WidgetHideMethodInfo
    ResolveFlapMethod "inDestruction" o = Gtk.Widget.WidgetInDestructionMethodInfo
    ResolveFlapMethod "initTemplate" o = Gtk.Widget.WidgetInitTemplateMethodInfo
    ResolveFlapMethod "insertActionGroup" o = Gtk.Widget.WidgetInsertActionGroupMethodInfo
    ResolveFlapMethod "insertAfter" o = Gtk.Widget.WidgetInsertAfterMethodInfo
    ResolveFlapMethod "insertBefore" o = Gtk.Widget.WidgetInsertBeforeMethodInfo
    ResolveFlapMethod "isAncestor" o = Gtk.Widget.WidgetIsAncestorMethodInfo
    ResolveFlapMethod "isDrawable" o = Gtk.Widget.WidgetIsDrawableMethodInfo
    ResolveFlapMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFlapMethod "isFocus" o = Gtk.Widget.WidgetIsFocusMethodInfo
    ResolveFlapMethod "isSensitive" o = Gtk.Widget.WidgetIsSensitiveMethodInfo
    ResolveFlapMethod "isVisible" o = Gtk.Widget.WidgetIsVisibleMethodInfo
    ResolveFlapMethod "keynavFailed" o = Gtk.Widget.WidgetKeynavFailedMethodInfo
    ResolveFlapMethod "listMnemonicLabels" o = Gtk.Widget.WidgetListMnemonicLabelsMethodInfo
    ResolveFlapMethod "map" o = Gtk.Widget.WidgetMapMethodInfo
    ResolveFlapMethod "measure" o = Gtk.Widget.WidgetMeasureMethodInfo
    ResolveFlapMethod "mnemonicActivate" o = Gtk.Widget.WidgetMnemonicActivateMethodInfo
    ResolveFlapMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFlapMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFlapMethod "observeChildren" o = Gtk.Widget.WidgetObserveChildrenMethodInfo
    ResolveFlapMethod "observeControllers" o = Gtk.Widget.WidgetObserveControllersMethodInfo
    ResolveFlapMethod "pick" o = Gtk.Widget.WidgetPickMethodInfo
    ResolveFlapMethod "queueAllocate" o = Gtk.Widget.WidgetQueueAllocateMethodInfo
    ResolveFlapMethod "queueDraw" o = Gtk.Widget.WidgetQueueDrawMethodInfo
    ResolveFlapMethod "queueResize" o = Gtk.Widget.WidgetQueueResizeMethodInfo
    ResolveFlapMethod "realize" o = Gtk.Widget.WidgetRealizeMethodInfo
    ResolveFlapMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFlapMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFlapMethod "removeController" o = Gtk.Widget.WidgetRemoveControllerMethodInfo
    ResolveFlapMethod "removeCssClass" o = Gtk.Widget.WidgetRemoveCssClassMethodInfo
    ResolveFlapMethod "removeMnemonicLabel" o = Gtk.Widget.WidgetRemoveMnemonicLabelMethodInfo
    ResolveFlapMethod "removeTickCallback" o = Gtk.Widget.WidgetRemoveTickCallbackMethodInfo
    ResolveFlapMethod "resetProperty" o = Gtk.Accessible.AccessibleResetPropertyMethodInfo
    ResolveFlapMethod "resetRelation" o = Gtk.Accessible.AccessibleResetRelationMethodInfo
    ResolveFlapMethod "resetState" o = Gtk.Accessible.AccessibleResetStateMethodInfo
    ResolveFlapMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFlapMethod "shouldLayout" o = Gtk.Widget.WidgetShouldLayoutMethodInfo
    ResolveFlapMethod "show" o = Gtk.Widget.WidgetShowMethodInfo
    ResolveFlapMethod "sizeAllocate" o = Gtk.Widget.WidgetSizeAllocateMethodInfo
    ResolveFlapMethod "snapshotChild" o = Gtk.Widget.WidgetSnapshotChildMethodInfo
    ResolveFlapMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFlapMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFlapMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFlapMethod "translateCoordinates" o = Gtk.Widget.WidgetTranslateCoordinatesMethodInfo
    ResolveFlapMethod "triggerTooltipQuery" o = Gtk.Widget.WidgetTriggerTooltipQueryMethodInfo
    ResolveFlapMethod "unmap" o = Gtk.Widget.WidgetUnmapMethodInfo
    ResolveFlapMethod "unparent" o = Gtk.Widget.WidgetUnparentMethodInfo
    ResolveFlapMethod "unrealize" o = Gtk.Widget.WidgetUnrealizeMethodInfo
    ResolveFlapMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFlapMethod "unsetStateFlags" o = Gtk.Widget.WidgetUnsetStateFlagsMethodInfo
    ResolveFlapMethod "updateNextAccessibleSibling" o = Gtk.Accessible.AccessibleUpdateNextAccessibleSiblingMethodInfo
    ResolveFlapMethod "updateProperty" o = Gtk.Accessible.AccessibleUpdatePropertyMethodInfo
    ResolveFlapMethod "updateRelation" o = Gtk.Accessible.AccessibleUpdateRelationMethodInfo
    ResolveFlapMethod "updateState" o = Gtk.Accessible.AccessibleUpdateStateMethodInfo
    ResolveFlapMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFlapMethod "getAccessibleParent" o = Gtk.Accessible.AccessibleGetAccessibleParentMethodInfo
    ResolveFlapMethod "getAccessibleRole" o = Gtk.Accessible.AccessibleGetAccessibleRoleMethodInfo
    ResolveFlapMethod "getAllocatedBaseline" o = Gtk.Widget.WidgetGetAllocatedBaselineMethodInfo
    ResolveFlapMethod "getAllocatedHeight" o = Gtk.Widget.WidgetGetAllocatedHeightMethodInfo
    ResolveFlapMethod "getAllocatedWidth" o = Gtk.Widget.WidgetGetAllocatedWidthMethodInfo
    ResolveFlapMethod "getAllocation" o = Gtk.Widget.WidgetGetAllocationMethodInfo
    ResolveFlapMethod "getAncestor" o = Gtk.Widget.WidgetGetAncestorMethodInfo
    ResolveFlapMethod "getAtContext" o = Gtk.Accessible.AccessibleGetAtContextMethodInfo
    ResolveFlapMethod "getBounds" o = Gtk.Accessible.AccessibleGetBoundsMethodInfo
    ResolveFlapMethod "getBuildableId" o = Gtk.Buildable.BuildableGetBuildableIdMethodInfo
    ResolveFlapMethod "getCanFocus" o = Gtk.Widget.WidgetGetCanFocusMethodInfo
    ResolveFlapMethod "getCanTarget" o = Gtk.Widget.WidgetGetCanTargetMethodInfo
    ResolveFlapMethod "getCancelProgress" o = Adw.Swipeable.SwipeableGetCancelProgressMethodInfo
    ResolveFlapMethod "getChildVisible" o = Gtk.Widget.WidgetGetChildVisibleMethodInfo
    ResolveFlapMethod "getClipboard" o = Gtk.Widget.WidgetGetClipboardMethodInfo
    ResolveFlapMethod "getColor" o = Gtk.Widget.WidgetGetColorMethodInfo
    ResolveFlapMethod "getContent" o = FlapGetContentMethodInfo
    ResolveFlapMethod "getCssClasses" o = Gtk.Widget.WidgetGetCssClassesMethodInfo
    ResolveFlapMethod "getCssName" o = Gtk.Widget.WidgetGetCssNameMethodInfo
    ResolveFlapMethod "getCursor" o = Gtk.Widget.WidgetGetCursorMethodInfo
    ResolveFlapMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFlapMethod "getDirection" o = Gtk.Widget.WidgetGetDirectionMethodInfo
    ResolveFlapMethod "getDisplay" o = Gtk.Widget.WidgetGetDisplayMethodInfo
    ResolveFlapMethod "getDistance" o = Adw.Swipeable.SwipeableGetDistanceMethodInfo
    ResolveFlapMethod "getFirstAccessibleChild" o = Gtk.Accessible.AccessibleGetFirstAccessibleChildMethodInfo
    ResolveFlapMethod "getFirstChild" o = Gtk.Widget.WidgetGetFirstChildMethodInfo
    ResolveFlapMethod "getFlap" o = FlapGetFlapMethodInfo
    ResolveFlapMethod "getFlapPosition" o = FlapGetFlapPositionMethodInfo
    ResolveFlapMethod "getFocusChild" o = Gtk.Widget.WidgetGetFocusChildMethodInfo
    ResolveFlapMethod "getFocusOnClick" o = Gtk.Widget.WidgetGetFocusOnClickMethodInfo
    ResolveFlapMethod "getFocusable" o = Gtk.Widget.WidgetGetFocusableMethodInfo
    ResolveFlapMethod "getFoldDuration" o = FlapGetFoldDurationMethodInfo
    ResolveFlapMethod "getFoldPolicy" o = FlapGetFoldPolicyMethodInfo
    ResolveFlapMethod "getFoldThresholdPolicy" o = FlapGetFoldThresholdPolicyMethodInfo
    ResolveFlapMethod "getFolded" o = FlapGetFoldedMethodInfo
    ResolveFlapMethod "getFontMap" o = Gtk.Widget.WidgetGetFontMapMethodInfo
    ResolveFlapMethod "getFontOptions" o = Gtk.Widget.WidgetGetFontOptionsMethodInfo
    ResolveFlapMethod "getFrameClock" o = Gtk.Widget.WidgetGetFrameClockMethodInfo
    ResolveFlapMethod "getHalign" o = Gtk.Widget.WidgetGetHalignMethodInfo
    ResolveFlapMethod "getHasTooltip" o = Gtk.Widget.WidgetGetHasTooltipMethodInfo
    ResolveFlapMethod "getHeight" o = Gtk.Widget.WidgetGetHeightMethodInfo
    ResolveFlapMethod "getHexpand" o = Gtk.Widget.WidgetGetHexpandMethodInfo
    ResolveFlapMethod "getHexpandSet" o = Gtk.Widget.WidgetGetHexpandSetMethodInfo
    ResolveFlapMethod "getLastChild" o = Gtk.Widget.WidgetGetLastChildMethodInfo
    ResolveFlapMethod "getLayoutManager" o = Gtk.Widget.WidgetGetLayoutManagerMethodInfo
    ResolveFlapMethod "getLocked" o = FlapGetLockedMethodInfo
    ResolveFlapMethod "getMapped" o = Gtk.Widget.WidgetGetMappedMethodInfo
    ResolveFlapMethod "getMarginBottom" o = Gtk.Widget.WidgetGetMarginBottomMethodInfo
    ResolveFlapMethod "getMarginEnd" o = Gtk.Widget.WidgetGetMarginEndMethodInfo
    ResolveFlapMethod "getMarginStart" o = Gtk.Widget.WidgetGetMarginStartMethodInfo
    ResolveFlapMethod "getMarginTop" o = Gtk.Widget.WidgetGetMarginTopMethodInfo
    ResolveFlapMethod "getModal" o = FlapGetModalMethodInfo
    ResolveFlapMethod "getName" o = Gtk.Widget.WidgetGetNameMethodInfo
    ResolveFlapMethod "getNative" o = Gtk.Widget.WidgetGetNativeMethodInfo
    ResolveFlapMethod "getNextAccessibleSibling" o = Gtk.Accessible.AccessibleGetNextAccessibleSiblingMethodInfo
    ResolveFlapMethod "getNextSibling" o = Gtk.Widget.WidgetGetNextSiblingMethodInfo
    ResolveFlapMethod "getOpacity" o = Gtk.Widget.WidgetGetOpacityMethodInfo
    ResolveFlapMethod "getOrientation" o = Gtk.Orientable.OrientableGetOrientationMethodInfo
    ResolveFlapMethod "getOverflow" o = Gtk.Widget.WidgetGetOverflowMethodInfo
    ResolveFlapMethod "getPangoContext" o = Gtk.Widget.WidgetGetPangoContextMethodInfo
    ResolveFlapMethod "getParent" o = Gtk.Widget.WidgetGetParentMethodInfo
    ResolveFlapMethod "getPlatformState" o = Gtk.Accessible.AccessibleGetPlatformStateMethodInfo
    ResolveFlapMethod "getPreferredSize" o = Gtk.Widget.WidgetGetPreferredSizeMethodInfo
    ResolveFlapMethod "getPrevSibling" o = Gtk.Widget.WidgetGetPrevSiblingMethodInfo
    ResolveFlapMethod "getPrimaryClipboard" o = Gtk.Widget.WidgetGetPrimaryClipboardMethodInfo
    ResolveFlapMethod "getProgress" o = Adw.Swipeable.SwipeableGetProgressMethodInfo
    ResolveFlapMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFlapMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFlapMethod "getRealized" o = Gtk.Widget.WidgetGetRealizedMethodInfo
    ResolveFlapMethod "getReceivesDefault" o = Gtk.Widget.WidgetGetReceivesDefaultMethodInfo
    ResolveFlapMethod "getRequestMode" o = Gtk.Widget.WidgetGetRequestModeMethodInfo
    ResolveFlapMethod "getRevealFlap" o = FlapGetRevealFlapMethodInfo
    ResolveFlapMethod "getRevealParams" o = FlapGetRevealParamsMethodInfo
    ResolveFlapMethod "getRevealProgress" o = FlapGetRevealProgressMethodInfo
    ResolveFlapMethod "getRoot" o = Gtk.Widget.WidgetGetRootMethodInfo
    ResolveFlapMethod "getScaleFactor" o = Gtk.Widget.WidgetGetScaleFactorMethodInfo
    ResolveFlapMethod "getSensitive" o = Gtk.Widget.WidgetGetSensitiveMethodInfo
    ResolveFlapMethod "getSeparator" o = FlapGetSeparatorMethodInfo
    ResolveFlapMethod "getSettings" o = Gtk.Widget.WidgetGetSettingsMethodInfo
    ResolveFlapMethod "getSize" o = Gtk.Widget.WidgetGetSizeMethodInfo
    ResolveFlapMethod "getSizeRequest" o = Gtk.Widget.WidgetGetSizeRequestMethodInfo
    ResolveFlapMethod "getSnapPoints" o = Adw.Swipeable.SwipeableGetSnapPointsMethodInfo
    ResolveFlapMethod "getStateFlags" o = Gtk.Widget.WidgetGetStateFlagsMethodInfo
    ResolveFlapMethod "getStyleContext" o = Gtk.Widget.WidgetGetStyleContextMethodInfo
    ResolveFlapMethod "getSwipeArea" o = Adw.Swipeable.SwipeableGetSwipeAreaMethodInfo
    ResolveFlapMethod "getSwipeToClose" o = FlapGetSwipeToCloseMethodInfo
    ResolveFlapMethod "getSwipeToOpen" o = FlapGetSwipeToOpenMethodInfo
    ResolveFlapMethod "getTemplateChild" o = Gtk.Widget.WidgetGetTemplateChildMethodInfo
    ResolveFlapMethod "getTooltipMarkup" o = Gtk.Widget.WidgetGetTooltipMarkupMethodInfo
    ResolveFlapMethod "getTooltipText" o = Gtk.Widget.WidgetGetTooltipTextMethodInfo
    ResolveFlapMethod "getTransitionType" o = FlapGetTransitionTypeMethodInfo
    ResolveFlapMethod "getValign" o = Gtk.Widget.WidgetGetValignMethodInfo
    ResolveFlapMethod "getVexpand" o = Gtk.Widget.WidgetGetVexpandMethodInfo
    ResolveFlapMethod "getVexpandSet" o = Gtk.Widget.WidgetGetVexpandSetMethodInfo
    ResolveFlapMethod "getVisible" o = Gtk.Widget.WidgetGetVisibleMethodInfo
    ResolveFlapMethod "getWidth" o = Gtk.Widget.WidgetGetWidthMethodInfo
    ResolveFlapMethod "setAccessibleParent" o = Gtk.Accessible.AccessibleSetAccessibleParentMethodInfo
    ResolveFlapMethod "setCanFocus" o = Gtk.Widget.WidgetSetCanFocusMethodInfo
    ResolveFlapMethod "setCanTarget" o = Gtk.Widget.WidgetSetCanTargetMethodInfo
    ResolveFlapMethod "setChildVisible" o = Gtk.Widget.WidgetSetChildVisibleMethodInfo
    ResolveFlapMethod "setContent" o = FlapSetContentMethodInfo
    ResolveFlapMethod "setCssClasses" o = Gtk.Widget.WidgetSetCssClassesMethodInfo
    ResolveFlapMethod "setCursor" o = Gtk.Widget.WidgetSetCursorMethodInfo
    ResolveFlapMethod "setCursorFromName" o = Gtk.Widget.WidgetSetCursorFromNameMethodInfo
    ResolveFlapMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFlapMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFlapMethod "setDirection" o = Gtk.Widget.WidgetSetDirectionMethodInfo
    ResolveFlapMethod "setFlap" o = FlapSetFlapMethodInfo
    ResolveFlapMethod "setFlapPosition" o = FlapSetFlapPositionMethodInfo
    ResolveFlapMethod "setFocusChild" o = Gtk.Widget.WidgetSetFocusChildMethodInfo
    ResolveFlapMethod "setFocusOnClick" o = Gtk.Widget.WidgetSetFocusOnClickMethodInfo
    ResolveFlapMethod "setFocusable" o = Gtk.Widget.WidgetSetFocusableMethodInfo
    ResolveFlapMethod "setFoldDuration" o = FlapSetFoldDurationMethodInfo
    ResolveFlapMethod "setFoldPolicy" o = FlapSetFoldPolicyMethodInfo
    ResolveFlapMethod "setFoldThresholdPolicy" o = FlapSetFoldThresholdPolicyMethodInfo
    ResolveFlapMethod "setFontMap" o = Gtk.Widget.WidgetSetFontMapMethodInfo
    ResolveFlapMethod "setFontOptions" o = Gtk.Widget.WidgetSetFontOptionsMethodInfo
    ResolveFlapMethod "setHalign" o = Gtk.Widget.WidgetSetHalignMethodInfo
    ResolveFlapMethod "setHasTooltip" o = Gtk.Widget.WidgetSetHasTooltipMethodInfo
    ResolveFlapMethod "setHexpand" o = Gtk.Widget.WidgetSetHexpandMethodInfo
    ResolveFlapMethod "setHexpandSet" o = Gtk.Widget.WidgetSetHexpandSetMethodInfo
    ResolveFlapMethod "setLayoutManager" o = Gtk.Widget.WidgetSetLayoutManagerMethodInfo
    ResolveFlapMethod "setLocked" o = FlapSetLockedMethodInfo
    ResolveFlapMethod "setMarginBottom" o = Gtk.Widget.WidgetSetMarginBottomMethodInfo
    ResolveFlapMethod "setMarginEnd" o = Gtk.Widget.WidgetSetMarginEndMethodInfo
    ResolveFlapMethod "setMarginStart" o = Gtk.Widget.WidgetSetMarginStartMethodInfo
    ResolveFlapMethod "setMarginTop" o = Gtk.Widget.WidgetSetMarginTopMethodInfo
    ResolveFlapMethod "setModal" o = FlapSetModalMethodInfo
    ResolveFlapMethod "setName" o = Gtk.Widget.WidgetSetNameMethodInfo
    ResolveFlapMethod "setOpacity" o = Gtk.Widget.WidgetSetOpacityMethodInfo
    ResolveFlapMethod "setOrientation" o = Gtk.Orientable.OrientableSetOrientationMethodInfo
    ResolveFlapMethod "setOverflow" o = Gtk.Widget.WidgetSetOverflowMethodInfo
    ResolveFlapMethod "setParent" o = Gtk.Widget.WidgetSetParentMethodInfo
    ResolveFlapMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFlapMethod "setReceivesDefault" o = Gtk.Widget.WidgetSetReceivesDefaultMethodInfo
    ResolveFlapMethod "setRevealFlap" o = FlapSetRevealFlapMethodInfo
    ResolveFlapMethod "setRevealParams" o = FlapSetRevealParamsMethodInfo
    ResolveFlapMethod "setSensitive" o = Gtk.Widget.WidgetSetSensitiveMethodInfo
    ResolveFlapMethod "setSeparator" o = FlapSetSeparatorMethodInfo
    ResolveFlapMethod "setSizeRequest" o = Gtk.Widget.WidgetSetSizeRequestMethodInfo
    ResolveFlapMethod "setStateFlags" o = Gtk.Widget.WidgetSetStateFlagsMethodInfo
    ResolveFlapMethod "setSwipeToClose" o = FlapSetSwipeToCloseMethodInfo
    ResolveFlapMethod "setSwipeToOpen" o = FlapSetSwipeToOpenMethodInfo
    ResolveFlapMethod "setTooltipMarkup" o = Gtk.Widget.WidgetSetTooltipMarkupMethodInfo
    ResolveFlapMethod "setTooltipText" o = Gtk.Widget.WidgetSetTooltipTextMethodInfo
    ResolveFlapMethod "setTransitionType" o = FlapSetTransitionTypeMethodInfo
    ResolveFlapMethod "setValign" o = Gtk.Widget.WidgetSetValignMethodInfo
    ResolveFlapMethod "setVexpand" o = Gtk.Widget.WidgetSetVexpandMethodInfo
    ResolveFlapMethod "setVexpandSet" o = Gtk.Widget.WidgetSetVexpandSetMethodInfo
    ResolveFlapMethod "setVisible" o = Gtk.Widget.WidgetSetVisibleMethodInfo
    ResolveFlapMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveFlapMethod t Flap, O.OverloadedMethod info Flap p, R.HasField t Flap p) => R.HasField t Flap p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

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

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

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

-- | Set the value of the “@content@” 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' #content
-- @
clearFlapContent :: (MonadIO m, IsFlap o) => o -> m ()
clearFlapContent :: forall (m :: * -> *) o. (MonadIO m, IsFlap o) => o -> m ()
clearFlapContent o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"content" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data FlapContentPropertyInfo
instance AttrInfo FlapContentPropertyInfo where
    type AttrAllowedOps FlapContentPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FlapContentPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapContentPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint FlapContentPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType FlapContentPropertyInfo = Gtk.Widget.Widget
    type AttrGetType FlapContentPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel FlapContentPropertyInfo = "content"
    type AttrOrigin FlapContentPropertyInfo = Flap
    attrGet = getFlapContent
    attrSet = setFlapContent
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructFlapContent
    attrClear = clearFlapContent
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.content"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:content"
        })
#endif

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

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

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

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

-- | Set the value of the “@flap@” 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' #flap
-- @
clearFlapFlap :: (MonadIO m, IsFlap o) => o -> m ()
clearFlapFlap :: forall (m :: * -> *) o. (MonadIO m, IsFlap o) => o -> m ()
clearFlapFlap o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"flap" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data FlapFlapPropertyInfo
instance AttrInfo FlapFlapPropertyInfo where
    type AttrAllowedOps FlapFlapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FlapFlapPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapFlapPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint FlapFlapPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType FlapFlapPropertyInfo = Gtk.Widget.Widget
    type AttrGetType FlapFlapPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel FlapFlapPropertyInfo = "flap"
    type AttrOrigin FlapFlapPropertyInfo = Flap
    attrGet = getFlapFlap
    attrSet = setFlapFlap
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructFlapFlap
    attrClear = clearFlapFlap
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.flap"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:flap"
        })
#endif

-- VVV Prop "flap-position"
   -- Type: TInterface (Name {namespace = "Gtk", name = "PackType"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

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

-- | Construct a `GValueConstruct` with valid value for the “@flap-position@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFlapFlapPosition :: (IsFlap o, MIO.MonadIO m) => Gtk.Enums.PackType -> m (GValueConstruct o)
constructFlapFlapPosition :: forall o (m :: * -> *).
(IsFlap o, MonadIO m) =>
PackType -> m (GValueConstruct o)
constructFlapFlapPosition PackType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> PackType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"flap-position" PackType
val

#if defined(ENABLE_OVERLOADING)
data FlapFlapPositionPropertyInfo
instance AttrInfo FlapFlapPositionPropertyInfo where
    type AttrAllowedOps FlapFlapPositionPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapFlapPositionPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapFlapPositionPropertyInfo = (~) Gtk.Enums.PackType
    type AttrTransferTypeConstraint FlapFlapPositionPropertyInfo = (~) Gtk.Enums.PackType
    type AttrTransferType FlapFlapPositionPropertyInfo = Gtk.Enums.PackType
    type AttrGetType FlapFlapPositionPropertyInfo = Gtk.Enums.PackType
    type AttrLabel FlapFlapPositionPropertyInfo = "flap-position"
    type AttrOrigin FlapFlapPositionPropertyInfo = Flap
    attrGet = getFlapFlapPosition
    attrSet = setFlapFlapPosition
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapFlapPosition
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.flapPosition"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:flapPosition"
        })
#endif

-- VVV Prop "fold-duration"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@fold-duration@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' flap #foldDuration
-- @
getFlapFoldDuration :: (MonadIO m, IsFlap o) => o -> m Word32
getFlapFoldDuration :: forall (m :: * -> *) o. (MonadIO m, IsFlap o) => o -> m Word32
getFlapFoldDuration o
obj = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj String
"fold-duration"

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

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

#if defined(ENABLE_OVERLOADING)
data FlapFoldDurationPropertyInfo
instance AttrInfo FlapFoldDurationPropertyInfo where
    type AttrAllowedOps FlapFoldDurationPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapFoldDurationPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapFoldDurationPropertyInfo = (~) Word32
    type AttrTransferTypeConstraint FlapFoldDurationPropertyInfo = (~) Word32
    type AttrTransferType FlapFoldDurationPropertyInfo = Word32
    type AttrGetType FlapFoldDurationPropertyInfo = Word32
    type AttrLabel FlapFoldDurationPropertyInfo = "fold-duration"
    type AttrOrigin FlapFoldDurationPropertyInfo = Flap
    attrGet = getFlapFoldDuration
    attrSet = setFlapFoldDuration
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapFoldDuration
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.foldDuration"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:foldDuration"
        })
#endif

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

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

-- | Set the value of the “@fold-policy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' flap [ #foldPolicy 'Data.GI.Base.Attributes.:=' value ]
-- @
setFlapFoldPolicy :: (MonadIO m, IsFlap o) => o -> Adw.Enums.FlapFoldPolicy -> m ()
setFlapFoldPolicy :: forall (m :: * -> *) o.
(MonadIO m, IsFlap o) =>
o -> FlapFoldPolicy -> m ()
setFlapFoldPolicy o
obj FlapFoldPolicy
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> FlapFoldPolicy -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"fold-policy" FlapFoldPolicy
val

-- | Construct a `GValueConstruct` with valid value for the “@fold-policy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFlapFoldPolicy :: (IsFlap o, MIO.MonadIO m) => Adw.Enums.FlapFoldPolicy -> m (GValueConstruct o)
constructFlapFoldPolicy :: forall o (m :: * -> *).
(IsFlap o, MonadIO m) =>
FlapFoldPolicy -> m (GValueConstruct o)
constructFlapFoldPolicy FlapFoldPolicy
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> FlapFoldPolicy -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"fold-policy" FlapFoldPolicy
val

#if defined(ENABLE_OVERLOADING)
data FlapFoldPolicyPropertyInfo
instance AttrInfo FlapFoldPolicyPropertyInfo where
    type AttrAllowedOps FlapFoldPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapFoldPolicyPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapFoldPolicyPropertyInfo = (~) Adw.Enums.FlapFoldPolicy
    type AttrTransferTypeConstraint FlapFoldPolicyPropertyInfo = (~) Adw.Enums.FlapFoldPolicy
    type AttrTransferType FlapFoldPolicyPropertyInfo = Adw.Enums.FlapFoldPolicy
    type AttrGetType FlapFoldPolicyPropertyInfo = Adw.Enums.FlapFoldPolicy
    type AttrLabel FlapFoldPolicyPropertyInfo = "fold-policy"
    type AttrOrigin FlapFoldPolicyPropertyInfo = Flap
    attrGet = getFlapFoldPolicy
    attrSet = setFlapFoldPolicy
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapFoldPolicy
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.foldPolicy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:foldPolicy"
        })
#endif

-- VVV Prop "fold-threshold-policy"
   -- Type: TInterface (Name {namespace = "Adw", name = "FoldThresholdPolicy"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

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

-- | Set the value of the “@fold-threshold-policy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' flap [ #foldThresholdPolicy 'Data.GI.Base.Attributes.:=' value ]
-- @
setFlapFoldThresholdPolicy :: (MonadIO m, IsFlap o) => o -> Adw.Enums.FoldThresholdPolicy -> m ()
setFlapFoldThresholdPolicy :: forall (m :: * -> *) o.
(MonadIO m, IsFlap o) =>
o -> FoldThresholdPolicy -> m ()
setFlapFoldThresholdPolicy o
obj FoldThresholdPolicy
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> FoldThresholdPolicy -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"fold-threshold-policy" FoldThresholdPolicy
val

-- | Construct a `GValueConstruct` with valid value for the “@fold-threshold-policy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFlapFoldThresholdPolicy :: (IsFlap o, MIO.MonadIO m) => Adw.Enums.FoldThresholdPolicy -> m (GValueConstruct o)
constructFlapFoldThresholdPolicy :: forall o (m :: * -> *).
(IsFlap o, MonadIO m) =>
FoldThresholdPolicy -> m (GValueConstruct o)
constructFlapFoldThresholdPolicy FoldThresholdPolicy
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> FoldThresholdPolicy -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"fold-threshold-policy" FoldThresholdPolicy
val

#if defined(ENABLE_OVERLOADING)
data FlapFoldThresholdPolicyPropertyInfo
instance AttrInfo FlapFoldThresholdPolicyPropertyInfo where
    type AttrAllowedOps FlapFoldThresholdPolicyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapFoldThresholdPolicyPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapFoldThresholdPolicyPropertyInfo = (~) Adw.Enums.FoldThresholdPolicy
    type AttrTransferTypeConstraint FlapFoldThresholdPolicyPropertyInfo = (~) Adw.Enums.FoldThresholdPolicy
    type AttrTransferType FlapFoldThresholdPolicyPropertyInfo = Adw.Enums.FoldThresholdPolicy
    type AttrGetType FlapFoldThresholdPolicyPropertyInfo = Adw.Enums.FoldThresholdPolicy
    type AttrLabel FlapFoldThresholdPolicyPropertyInfo = "fold-threshold-policy"
    type AttrOrigin FlapFoldThresholdPolicyPropertyInfo = Flap
    attrGet = getFlapFoldThresholdPolicy
    attrSet = setFlapFoldThresholdPolicy
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapFoldThresholdPolicy
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.foldThresholdPolicy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:foldThresholdPolicy"
        })
#endif

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

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

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FlapLockedPropertyInfo
instance AttrInfo FlapLockedPropertyInfo where
    type AttrAllowedOps FlapLockedPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapLockedPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapLockedPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlapLockedPropertyInfo = (~) Bool
    type AttrTransferType FlapLockedPropertyInfo = Bool
    type AttrGetType FlapLockedPropertyInfo = Bool
    type AttrLabel FlapLockedPropertyInfo = "locked"
    type AttrOrigin FlapLockedPropertyInfo = Flap
    attrGet = getFlapLocked
    attrSet = setFlapLocked
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapLocked
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.locked"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:locked"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FlapModalPropertyInfo
instance AttrInfo FlapModalPropertyInfo where
    type AttrAllowedOps FlapModalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapModalPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapModalPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlapModalPropertyInfo = (~) Bool
    type AttrTransferType FlapModalPropertyInfo = Bool
    type AttrGetType FlapModalPropertyInfo = Bool
    type AttrLabel FlapModalPropertyInfo = "modal"
    type AttrOrigin FlapModalPropertyInfo = Flap
    attrGet = getFlapModal
    attrSet = setFlapModal
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapModal
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.modal"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:modal"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FlapRevealFlapPropertyInfo
instance AttrInfo FlapRevealFlapPropertyInfo where
    type AttrAllowedOps FlapRevealFlapPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapRevealFlapPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapRevealFlapPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlapRevealFlapPropertyInfo = (~) Bool
    type AttrTransferType FlapRevealFlapPropertyInfo = Bool
    type AttrGetType FlapRevealFlapPropertyInfo = Bool
    type AttrLabel FlapRevealFlapPropertyInfo = "reveal-flap"
    type AttrOrigin FlapRevealFlapPropertyInfo = Flap
    attrGet = getFlapRevealFlap
    attrSet = setFlapRevealFlap
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapRevealFlap
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.revealFlap"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:revealFlap"
        })
#endif

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

-- | Get the value of the “@reveal-params@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' flap #revealParams
-- @
getFlapRevealParams :: (MonadIO m, IsFlap o) => o -> m (Maybe Adw.SpringParams.SpringParams)
getFlapRevealParams :: forall (m :: * -> *) o.
(MonadIO m, IsFlap o) =>
o -> m (Maybe SpringParams)
getFlapRevealParams o
obj = IO (Maybe SpringParams) -> m (Maybe SpringParams)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe SpringParams) -> m (Maybe SpringParams))
-> IO (Maybe SpringParams) -> m (Maybe SpringParams)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr SpringParams -> SpringParams)
-> IO (Maybe SpringParams)
forall a b.
(GObject a, GBoxed b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj String
"reveal-params" ManagedPtr SpringParams -> SpringParams
Adw.SpringParams.SpringParams

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

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

#if defined(ENABLE_OVERLOADING)
data FlapRevealParamsPropertyInfo
instance AttrInfo FlapRevealParamsPropertyInfo where
    type AttrAllowedOps FlapRevealParamsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapRevealParamsPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapRevealParamsPropertyInfo = (~) Adw.SpringParams.SpringParams
    type AttrTransferTypeConstraint FlapRevealParamsPropertyInfo = (~) Adw.SpringParams.SpringParams
    type AttrTransferType FlapRevealParamsPropertyInfo = Adw.SpringParams.SpringParams
    type AttrGetType FlapRevealParamsPropertyInfo = (Maybe Adw.SpringParams.SpringParams)
    type AttrLabel FlapRevealParamsPropertyInfo = "reveal-params"
    type AttrOrigin FlapRevealParamsPropertyInfo = Flap
    attrGet = getFlapRevealParams
    attrSet = setFlapRevealParams
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapRevealParams
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.revealParams"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:revealParams"
        })
#endif

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

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

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

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

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

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

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

-- | Set the value of the “@separator@” 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' #separator
-- @
clearFlapSeparator :: (MonadIO m, IsFlap o) => o -> m ()
clearFlapSeparator :: forall (m :: * -> *) o. (MonadIO m, IsFlap o) => o -> m ()
clearFlapSeparator o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> Maybe Widget -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"separator" (Maybe Widget
forall a. Maybe a
Nothing :: Maybe Gtk.Widget.Widget)

#if defined(ENABLE_OVERLOADING)
data FlapSeparatorPropertyInfo
instance AttrInfo FlapSeparatorPropertyInfo where
    type AttrAllowedOps FlapSeparatorPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FlapSeparatorPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapSeparatorPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint FlapSeparatorPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType FlapSeparatorPropertyInfo = Gtk.Widget.Widget
    type AttrGetType FlapSeparatorPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel FlapSeparatorPropertyInfo = "separator"
    type AttrOrigin FlapSeparatorPropertyInfo = Flap
    attrGet = getFlapSeparator
    attrSet = setFlapSeparator
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructFlapSeparator
    attrClear = clearFlapSeparator
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.separator"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:separator"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FlapSwipeToClosePropertyInfo
instance AttrInfo FlapSwipeToClosePropertyInfo where
    type AttrAllowedOps FlapSwipeToClosePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapSwipeToClosePropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapSwipeToClosePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlapSwipeToClosePropertyInfo = (~) Bool
    type AttrTransferType FlapSwipeToClosePropertyInfo = Bool
    type AttrGetType FlapSwipeToClosePropertyInfo = Bool
    type AttrLabel FlapSwipeToClosePropertyInfo = "swipe-to-close"
    type AttrOrigin FlapSwipeToClosePropertyInfo = Flap
    attrGet = getFlapSwipeToClose
    attrSet = setFlapSwipeToClose
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapSwipeToClose
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.swipeToClose"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:swipeToClose"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FlapSwipeToOpenPropertyInfo
instance AttrInfo FlapSwipeToOpenPropertyInfo where
    type AttrAllowedOps FlapSwipeToOpenPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapSwipeToOpenPropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapSwipeToOpenPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FlapSwipeToOpenPropertyInfo = (~) Bool
    type AttrTransferType FlapSwipeToOpenPropertyInfo = Bool
    type AttrGetType FlapSwipeToOpenPropertyInfo = Bool
    type AttrLabel FlapSwipeToOpenPropertyInfo = "swipe-to-open"
    type AttrOrigin FlapSwipeToOpenPropertyInfo = Flap
    attrGet = getFlapSwipeToOpen
    attrSet = setFlapSwipeToOpen
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapSwipeToOpen
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.swipeToOpen"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:swipeToOpen"
        })
#endif

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

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

-- | Set the value of the “@transition-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' flap [ #transitionType 'Data.GI.Base.Attributes.:=' value ]
-- @
setFlapTransitionType :: (MonadIO m, IsFlap o) => o -> Adw.Enums.FlapTransitionType -> m ()
setFlapTransitionType :: forall (m :: * -> *) o.
(MonadIO m, IsFlap o) =>
o -> FlapTransitionType -> m ()
setFlapTransitionType o
obj FlapTransitionType
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> FlapTransitionType -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"transition-type" FlapTransitionType
val

-- | Construct a `GValueConstruct` with valid value for the “@transition-type@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFlapTransitionType :: (IsFlap o, MIO.MonadIO m) => Adw.Enums.FlapTransitionType -> m (GValueConstruct o)
constructFlapTransitionType :: forall o (m :: * -> *).
(IsFlap o, MonadIO m) =>
FlapTransitionType -> m (GValueConstruct o)
constructFlapTransitionType FlapTransitionType
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> FlapTransitionType -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"transition-type" FlapTransitionType
val

#if defined(ENABLE_OVERLOADING)
data FlapTransitionTypePropertyInfo
instance AttrInfo FlapTransitionTypePropertyInfo where
    type AttrAllowedOps FlapTransitionTypePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FlapTransitionTypePropertyInfo = IsFlap
    type AttrSetTypeConstraint FlapTransitionTypePropertyInfo = (~) Adw.Enums.FlapTransitionType
    type AttrTransferTypeConstraint FlapTransitionTypePropertyInfo = (~) Adw.Enums.FlapTransitionType
    type AttrTransferType FlapTransitionTypePropertyInfo = Adw.Enums.FlapTransitionType
    type AttrGetType FlapTransitionTypePropertyInfo = Adw.Enums.FlapTransitionType
    type AttrLabel FlapTransitionTypePropertyInfo = "transition-type"
    type AttrOrigin FlapTransitionTypePropertyInfo = Flap
    attrGet = getFlapTransitionType
    attrSet = setFlapTransitionType
    attrTransfer _ v = do
        return v
    attrConstruct = constructFlapTransitionType
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.Flap.transitionType"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.5/docs/GI-Adw-Objects-Flap.html#g:attr:transitionType"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Flap
type instance O.AttributeList Flap = FlapAttributeList
type FlapAttributeList = ('[ '("accessibleRole", Gtk.Accessible.AccessibleAccessibleRolePropertyInfo), '("canFocus", Gtk.Widget.WidgetCanFocusPropertyInfo), '("canTarget", Gtk.Widget.WidgetCanTargetPropertyInfo), '("content", FlapContentPropertyInfo), '("cssClasses", Gtk.Widget.WidgetCssClassesPropertyInfo), '("cssName", Gtk.Widget.WidgetCssNamePropertyInfo), '("cursor", Gtk.Widget.WidgetCursorPropertyInfo), '("flap", FlapFlapPropertyInfo), '("flapPosition", FlapFlapPositionPropertyInfo), '("focusOnClick", Gtk.Widget.WidgetFocusOnClickPropertyInfo), '("focusable", Gtk.Widget.WidgetFocusablePropertyInfo), '("foldDuration", FlapFoldDurationPropertyInfo), '("foldPolicy", FlapFoldPolicyPropertyInfo), '("foldThresholdPolicy", FlapFoldThresholdPolicyPropertyInfo), '("folded", FlapFoldedPropertyInfo), '("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), '("layoutManager", Gtk.Widget.WidgetLayoutManagerPropertyInfo), '("locked", FlapLockedPropertyInfo), '("marginBottom", Gtk.Widget.WidgetMarginBottomPropertyInfo), '("marginEnd", Gtk.Widget.WidgetMarginEndPropertyInfo), '("marginStart", Gtk.Widget.WidgetMarginStartPropertyInfo), '("marginTop", Gtk.Widget.WidgetMarginTopPropertyInfo), '("modal", FlapModalPropertyInfo), '("name", Gtk.Widget.WidgetNamePropertyInfo), '("opacity", Gtk.Widget.WidgetOpacityPropertyInfo), '("orientation", Gtk.Orientable.OrientableOrientationPropertyInfo), '("overflow", Gtk.Widget.WidgetOverflowPropertyInfo), '("parent", Gtk.Widget.WidgetParentPropertyInfo), '("receivesDefault", Gtk.Widget.WidgetReceivesDefaultPropertyInfo), '("revealFlap", FlapRevealFlapPropertyInfo), '("revealParams", FlapRevealParamsPropertyInfo), '("revealProgress", FlapRevealProgressPropertyInfo), '("root", Gtk.Widget.WidgetRootPropertyInfo), '("scaleFactor", Gtk.Widget.WidgetScaleFactorPropertyInfo), '("sensitive", Gtk.Widget.WidgetSensitivePropertyInfo), '("separator", FlapSeparatorPropertyInfo), '("swipeToClose", FlapSwipeToClosePropertyInfo), '("swipeToOpen", FlapSwipeToOpenPropertyInfo), '("tooltipMarkup", Gtk.Widget.WidgetTooltipMarkupPropertyInfo), '("tooltipText", Gtk.Widget.WidgetTooltipTextPropertyInfo), '("transitionType", FlapTransitionTypePropertyInfo), '("valign", Gtk.Widget.WidgetValignPropertyInfo), '("vexpand", Gtk.Widget.WidgetVexpandPropertyInfo), '("vexpandSet", Gtk.Widget.WidgetVexpandSetPropertyInfo), '("visible", Gtk.Widget.WidgetVisiblePropertyInfo), '("widthRequest", Gtk.Widget.WidgetWidthRequestPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
flapContent :: AttrLabelProxy "content"
flapContent = AttrLabelProxy

flapFlap :: AttrLabelProxy "flap"
flapFlap = AttrLabelProxy

flapFlapPosition :: AttrLabelProxy "flapPosition"
flapFlapPosition = AttrLabelProxy

flapFoldDuration :: AttrLabelProxy "foldDuration"
flapFoldDuration = AttrLabelProxy

flapFoldPolicy :: AttrLabelProxy "foldPolicy"
flapFoldPolicy = AttrLabelProxy

flapFoldThresholdPolicy :: AttrLabelProxy "foldThresholdPolicy"
flapFoldThresholdPolicy = AttrLabelProxy

flapFolded :: AttrLabelProxy "folded"
flapFolded = AttrLabelProxy

flapLocked :: AttrLabelProxy "locked"
flapLocked = AttrLabelProxy

flapModal :: AttrLabelProxy "modal"
flapModal = AttrLabelProxy

flapRevealFlap :: AttrLabelProxy "revealFlap"
flapRevealFlap = AttrLabelProxy

flapRevealParams :: AttrLabelProxy "revealParams"
flapRevealParams = AttrLabelProxy

flapRevealProgress :: AttrLabelProxy "revealProgress"
flapRevealProgress = AttrLabelProxy

flapSeparator :: AttrLabelProxy "separator"
flapSeparator = AttrLabelProxy

flapSwipeToClose :: AttrLabelProxy "swipeToClose"
flapSwipeToClose = AttrLabelProxy

flapSwipeToOpen :: AttrLabelProxy "swipeToOpen"
flapSwipeToOpen = AttrLabelProxy

flapTransitionType :: AttrLabelProxy "transitionType"
flapTransitionType = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Flap = FlapSignalList
type FlapSignalList = ('[ '("destroy", Gtk.Widget.WidgetDestroySignalInfo), '("directionChanged", Gtk.Widget.WidgetDirectionChangedSignalInfo), '("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, DK.Type)])

#endif

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

foreign import ccall "adw_flap_new" adw_flap_new :: 
    IO (Ptr Flap)

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

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | Gets the content widget for /@self@/.
flapGetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the content widget for /@self@/
flapGetContent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m (Maybe Widget)
flapGetContent a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Flap -> IO (Ptr Widget)
adw_flap_get_content Ptr Flap
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data FlapGetContentMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetContentMethodInfo a signature where
    overloadedMethod = flapGetContent

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


#endif

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

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

-- | Gets the flap widget for /@self@/.
flapGetFlap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the flap widget for /@self@/
flapGetFlap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m (Maybe Widget)
flapGetFlap a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Flap -> IO (Ptr Widget)
adw_flap_get_flap Ptr Flap
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data FlapGetFlapMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetFlapMethodInfo a signature where
    overloadedMethod = flapGetFlap

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


#endif

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

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

-- | Gets the flap position for /@self@/.
flapGetFlapPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Gtk.Enums.PackType
    -- ^ __Returns:__ the flap position for /@self@/
flapGetFlapPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m PackType
flapGetFlapPosition a
self = IO PackType -> m PackType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO PackType -> m PackType) -> IO PackType -> m PackType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Flap -> IO CUInt
adw_flap_get_flap_position Ptr Flap
self'
    let result' :: PackType
result' = (Int -> PackType
forall a. Enum a => Int -> a
toEnum (Int -> PackType) -> (CUInt -> Int) -> CUInt -> PackType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    PackType -> IO PackType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PackType
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetFlapPositionMethodInfo
instance (signature ~ (m Gtk.Enums.PackType), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetFlapPositionMethodInfo a signature where
    overloadedMethod = flapGetFlapPosition

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


#endif

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

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

-- | Gets the fold transition animation duration for /@self@/, in milliseconds.
flapGetFoldDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Word32
    -- ^ __Returns:__ the fold transition duration
flapGetFoldDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Word32
flapGetFoldDuration a
self = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr Flap -> IO Word32
adw_flap_get_fold_duration Ptr Flap
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data FlapGetFoldDurationMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetFoldDurationMethodInfo a signature where
    overloadedMethod = flapGetFoldDuration

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


#endif

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

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

-- | Gets the fold policy for /@self@/.
flapGetFoldPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Adw.Enums.FlapFoldPolicy
    -- ^ __Returns:__ the fold policy for /@self@/
flapGetFoldPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m FlapFoldPolicy
flapGetFoldPolicy a
self = IO FlapFoldPolicy -> m FlapFoldPolicy
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlapFoldPolicy -> m FlapFoldPolicy)
-> IO FlapFoldPolicy -> m FlapFoldPolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Flap -> IO CUInt
adw_flap_get_fold_policy Ptr Flap
self'
    let result' :: FlapFoldPolicy
result' = (Int -> FlapFoldPolicy
forall a. Enum a => Int -> a
toEnum (Int -> FlapFoldPolicy)
-> (CUInt -> Int) -> CUInt -> FlapFoldPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    FlapFoldPolicy -> IO FlapFoldPolicy
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlapFoldPolicy
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetFoldPolicyMethodInfo
instance (signature ~ (m Adw.Enums.FlapFoldPolicy), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetFoldPolicyMethodInfo a signature where
    overloadedMethod = flapGetFoldPolicy

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


#endif

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

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

-- | Gets the fold threshold policy for /@self@/.
flapGetFoldThresholdPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Adw.Enums.FoldThresholdPolicy
flapGetFoldThresholdPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m FoldThresholdPolicy
flapGetFoldThresholdPolicy a
self = IO FoldThresholdPolicy -> m FoldThresholdPolicy
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FoldThresholdPolicy -> m FoldThresholdPolicy)
-> IO FoldThresholdPolicy -> m FoldThresholdPolicy
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Flap -> IO CUInt
adw_flap_get_fold_threshold_policy Ptr Flap
self'
    let result' :: FoldThresholdPolicy
result' = (Int -> FoldThresholdPolicy
forall a. Enum a => Int -> a
toEnum (Int -> FoldThresholdPolicy)
-> (CUInt -> Int) -> CUInt -> FoldThresholdPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    FoldThresholdPolicy -> IO FoldThresholdPolicy
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FoldThresholdPolicy
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetFoldThresholdPolicyMethodInfo
instance (signature ~ (m Adw.Enums.FoldThresholdPolicy), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetFoldThresholdPolicyMethodInfo a signature where
    overloadedMethod = flapGetFoldThresholdPolicy

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


#endif

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

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

-- | Gets whether /@self@/ is currently folded.
-- 
-- See [property/@flap@/:fold-policy].
flapGetFolded ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@self@/ is currently folded
flapGetFolded :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Bool
flapGetFolded a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Flap -> IO CInt
adw_flap_get_folded Ptr Flap
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetFoldedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetFoldedMethodInfo a signature where
    overloadedMethod = flapGetFolded

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


#endif

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

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

-- | Gets whether /@self@/ is locked.
flapGetLocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@self@/ is locked
flapGetLocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Bool
flapGetLocked a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Flap -> IO CInt
adw_flap_get_locked Ptr Flap
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetLockedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetLockedMethodInfo a signature where
    overloadedMethod = flapGetLocked

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


#endif

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

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

-- | Gets whether /@self@/ is modal.
flapGetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@self@/ is modal
flapGetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Bool
flapGetModal a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Flap -> IO CInt
adw_flap_get_modal Ptr Flap
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetModalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetModalMethodInfo a signature where
    overloadedMethod = flapGetModal

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


#endif

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

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

-- | Gets whether the flap widget is revealed for /@self@/.
flapGetRevealFlap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if the flap widget is revealed
flapGetRevealFlap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Bool
flapGetRevealFlap a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Flap -> IO CInt
adw_flap_get_reveal_flap Ptr Flap
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetRevealFlapMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetRevealFlapMethodInfo a signature where
    overloadedMethod = flapGetRevealFlap

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


#endif

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

foreign import ccall "adw_flap_get_reveal_params" adw_flap_get_reveal_params :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    IO (Ptr Adw.SpringParams.SpringParams)

-- | Gets the reveal animation spring parameters for /@self@/.
flapGetRevealParams ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Adw.SpringParams.SpringParams
    -- ^ __Returns:__ the reveal animation parameters
flapGetRevealParams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m SpringParams
flapGetRevealParams a
self = IO SpringParams -> m SpringParams
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpringParams -> m SpringParams)
-> IO SpringParams -> m SpringParams
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SpringParams
result <- Ptr Flap -> IO (Ptr SpringParams)
adw_flap_get_reveal_params Ptr Flap
self'
    Text -> Ptr SpringParams -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"flapGetRevealParams" Ptr SpringParams
result
    SpringParams
result' <- ((ManagedPtr SpringParams -> SpringParams)
-> Ptr SpringParams -> IO SpringParams
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SpringParams -> SpringParams
Adw.SpringParams.SpringParams) Ptr SpringParams
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SpringParams -> IO SpringParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SpringParams
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetRevealParamsMethodInfo
instance (signature ~ (m Adw.SpringParams.SpringParams), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetRevealParamsMethodInfo a signature where
    overloadedMethod = flapGetRevealParams

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


#endif

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

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

-- | Gets the current reveal progress for /@self@/.
-- 
-- 0 means fully hidden, 1 means fully revealed.
-- 
-- See [property/@flap@/:reveal-flap].
flapGetRevealProgress ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Double
    -- ^ __Returns:__ the current reveal progress for /@self@/
flapGetRevealProgress :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Double
flapGetRevealProgress a
self = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CDouble
result <- Ptr Flap -> IO CDouble
adw_flap_get_reveal_progress Ptr Flap
self'
    let result' :: Double
result' = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Double
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetRevealProgressMethodInfo
instance (signature ~ (m Double), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetRevealProgressMethodInfo a signature where
    overloadedMethod = flapGetRevealProgress

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


#endif

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

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

-- | Gets the separator widget for /@self@/.
flapGetSeparator ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ the separator widget for /@self@/
flapGetSeparator :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m (Maybe Widget)
flapGetSeparator a
self = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Flap -> IO (Ptr Widget)
adw_flap_get_separator Ptr Flap
self'
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data FlapGetSeparatorMethodInfo
instance (signature ~ (m (Maybe Gtk.Widget.Widget)), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetSeparatorMethodInfo a signature where
    overloadedMethod = flapGetSeparator

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


#endif

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

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

-- | Gets whether /@self@/ can be closed with a swipe gesture.
flapGetSwipeToClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@self@/ can be closed with a swipe gesture
flapGetSwipeToClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Bool
flapGetSwipeToClose a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Flap -> IO CInt
adw_flap_get_swipe_to_close Ptr Flap
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetSwipeToCloseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetSwipeToCloseMethodInfo a signature where
    overloadedMethod = flapGetSwipeToClose

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


#endif

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

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

-- | Gets whether /@self@/ can be opened with a swipe gesture.
flapGetSwipeToOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Bool
    -- ^ __Returns:__ @TRUE@ if /@self@/ can be opened with a swipe gesture
flapGetSwipeToOpen :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m Bool
flapGetSwipeToOpen a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Flap -> IO CInt
adw_flap_get_swipe_to_open Ptr Flap
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetSwipeToOpenMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetSwipeToOpenMethodInfo a signature where
    overloadedMethod = flapGetSwipeToOpen

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


#endif

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

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

-- | Gets the type of animation used for reveal and fold transitions in /@self@/.
flapGetTransitionType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> m Adw.Enums.FlapTransitionType
    -- ^ __Returns:__ the current transition type of /@self@/
flapGetTransitionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> m FlapTransitionType
flapGetTransitionType a
self = IO FlapTransitionType -> m FlapTransitionType
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FlapTransitionType -> m FlapTransitionType)
-> IO FlapTransitionType -> m FlapTransitionType
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Flap -> IO CUInt
adw_flap_get_transition_type Ptr Flap
self'
    let result' :: FlapTransitionType
result' = (Int -> FlapTransitionType
forall a. Enum a => Int -> a
toEnum (Int -> FlapTransitionType)
-> (CUInt -> Int) -> CUInt -> FlapTransitionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    FlapTransitionType -> IO FlapTransitionType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FlapTransitionType
result'

#if defined(ENABLE_OVERLOADING)
data FlapGetTransitionTypeMethodInfo
instance (signature ~ (m Adw.Enums.FlapTransitionType), MonadIO m, IsFlap a) => O.OverloadedMethod FlapGetTransitionTypeMethodInfo a signature where
    overloadedMethod = flapGetTransitionType

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


#endif

-- method Flap::set_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the content widget for /@self@/.
-- 
-- It\'s always displayed when unfolded, and partially visible when folded.
flapSetContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a flap
    -> Maybe (b)
    -- ^ /@content@/: the content widget
    -> m ()
flapSetContent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFlap a, IsWidget b) =>
a -> Maybe b -> m ()
flapSetContent a
self Maybe b
content = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeContent <- case Maybe b
content of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jContent -> do
            Ptr Widget
jContent' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jContent
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jContent'
    Ptr Flap -> Ptr Widget -> IO ()
adw_flap_set_content Ptr Flap
self' Ptr Widget
maybeContent
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
content b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetContentMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFlap a, Gtk.Widget.IsWidget b) => O.OverloadedMethod FlapSetContentMethodInfo a signature where
    overloadedMethod = flapSetContent

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


#endif

-- method Flap::set_flap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flap"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the flap widget" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the flap widget for /@self@/.
-- 
-- It\'s only visible when [property/@flap@/:reveal-progress] is greater than 0.
flapSetFlap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a flap
    -> Maybe (b)
    -- ^ /@flap@/: the flap widget
    -> m ()
flapSetFlap :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFlap a, IsWidget b) =>
a -> Maybe b -> m ()
flapSetFlap a
self Maybe b
flap = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeFlap <- case Maybe b
flap of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jFlap -> do
            Ptr Widget
jFlap' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFlap
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jFlap'
    Ptr Flap -> Ptr Widget -> IO ()
adw_flap_set_flap Ptr Flap
self' Ptr Widget
maybeFlap
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
flap b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetFlapMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFlap a, Gtk.Widget.IsWidget b) => O.OverloadedMethod FlapSetFlapMethodInfo a signature where
    overloadedMethod = flapSetFlap

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


#endif

-- method Flap::set_flap_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "PackType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_flap_set_flap_position" adw_flap_set_flap_position :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    CUInt ->                                -- position : TInterface (Name {namespace = "Gtk", name = "PackType"})
    IO ()

-- | Sets the flap position for /@self@/.
-- 
-- If it\'s set to @GTK_PACK_START@, the flap is displayed before the content,
-- if @GTK_PACK_END@, it\'s displayed after the content.
flapSetFlapPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Gtk.Enums.PackType
    -- ^ /@position@/: the new value
    -> m ()
flapSetFlapPosition :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> PackType -> m ()
flapSetFlapPosition a
self PackType
position = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let position' :: CUInt
position' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (PackType -> Int) -> PackType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackType -> Int
forall a. Enum a => a -> Int
fromEnum) PackType
position
    Ptr Flap -> CUInt -> IO ()
adw_flap_set_flap_position Ptr Flap
self' CUInt
position'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetFlapPositionMethodInfo
instance (signature ~ (Gtk.Enums.PackType -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetFlapPositionMethodInfo a signature where
    overloadedMethod = flapSetFlapPosition

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


#endif

-- method Flap::set_fold_duration
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "duration"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new duration, in milliseconds"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_flap_set_fold_duration" adw_flap_set_fold_duration :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    Word32 ->                               -- duration : TBasicType TUInt
    IO ()

-- | Sets the fold transition animation duration for /@self@/, in milliseconds.
flapSetFoldDuration ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Word32
    -- ^ /@duration@/: the new duration, in milliseconds
    -> m ()
flapSetFoldDuration :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> Word32 -> m ()
flapSetFoldDuration a
self Word32
duration = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Flap -> Word32 -> IO ()
adw_flap_set_fold_duration Ptr Flap
self' Word32
duration
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetFoldDurationMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetFoldDurationMethodInfo a signature where
    overloadedMethod = flapSetFoldDuration

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


#endif

-- method Flap::set_fold_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "FlapFoldPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the fold policy" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_flap_set_fold_policy" adw_flap_set_fold_policy :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "Adw", name = "FlapFoldPolicy"})
    IO ()

-- | Sets the fold policy for /@self@/.
flapSetFoldPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Adw.Enums.FlapFoldPolicy
    -- ^ /@policy@/: the fold policy
    -> m ()
flapSetFoldPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> FlapFoldPolicy -> m ()
flapSetFoldPolicy a
self FlapFoldPolicy
policy = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FlapFoldPolicy -> Int) -> FlapFoldPolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlapFoldPolicy -> Int
forall a. Enum a => a -> Int
fromEnum) FlapFoldPolicy
policy
    Ptr Flap -> CUInt -> IO ()
adw_flap_set_fold_policy Ptr Flap
self' CUInt
policy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetFoldPolicyMethodInfo
instance (signature ~ (Adw.Enums.FlapFoldPolicy -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetFoldPolicyMethodInfo a signature where
    overloadedMethod = flapSetFoldPolicy

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


#endif

-- method Flap::set_fold_threshold_policy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "policy"
--           , argType =
--               TInterface
--                 Name { namespace = "Adw" , name = "FoldThresholdPolicy" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the policy to use" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_flap_set_fold_threshold_policy" adw_flap_set_fold_threshold_policy :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    CUInt ->                                -- policy : TInterface (Name {namespace = "Adw", name = "FoldThresholdPolicy"})
    IO ()

-- | Sets the fold threshold policy for /@self@/.
-- 
-- If set to @ADW_FOLD_THRESHOLD_POLICY_MINIMUM@, flap will only fold when the
-- children cannot fit anymore. With @ADW_FOLD_THRESHOLD_POLICY_NATURAL@, it
-- will fold as soon as children don\'t get their natural size.
-- 
-- This can be useful if you have a long ellipsizing label and want to let it
-- ellipsize instead of immediately folding.
flapSetFoldThresholdPolicy ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Adw.Enums.FoldThresholdPolicy
    -- ^ /@policy@/: the policy to use
    -> m ()
flapSetFoldThresholdPolicy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> FoldThresholdPolicy -> m ()
flapSetFoldThresholdPolicy a
self FoldThresholdPolicy
policy = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let policy' :: CUInt
policy' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FoldThresholdPolicy -> Int) -> FoldThresholdPolicy -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldThresholdPolicy -> Int
forall a. Enum a => a -> Int
fromEnum) FoldThresholdPolicy
policy
    Ptr Flap -> CUInt -> IO ()
adw_flap_set_fold_threshold_policy Ptr Flap
self' CUInt
policy'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetFoldThresholdPolicyMethodInfo
instance (signature ~ (Adw.Enums.FoldThresholdPolicy -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetFoldThresholdPolicyMethodInfo a signature where
    overloadedMethod = flapSetFoldThresholdPolicy

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


#endif

-- method Flap::set_locked
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "locked"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether /@self@/ is locked.
-- 
-- If @FALSE@, folding when the flap is revealed automatically closes it, and
-- unfolding it when the flap is not revealed opens it. If @TRUE@,
-- [property/@flap@/:reveal-flap] value never changes on its own.
flapSetLocked ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Bool
    -- ^ /@locked@/: the new value
    -> m ()
flapSetLocked :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> Bool -> m ()
flapSetLocked a
self Bool
locked = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let locked' :: CInt
locked' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
locked
    Ptr Flap -> CInt -> IO ()
adw_flap_set_locked Ptr Flap
self' CInt
locked'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetLockedMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetLockedMethodInfo a signature where
    overloadedMethod = flapSetLocked

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


#endif

-- method Flap::set_modal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modal"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether @self is modal"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether /@self@/ is modal.
-- 
-- If @TRUE@, clicking the content widget while flap is revealed, as well as
-- pressing the \<kbd>Esc\<\/kbd> key, will close the flap. If @FALSE@, clicks are
-- passed through to the content widget.
flapSetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Bool
    -- ^ /@modal@/: whether /@self@/ is modal
    -> m ()
flapSetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> Bool -> m ()
flapSetModal a
self Bool
modal = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let modal' :: CInt
modal' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
modal
    Ptr Flap -> CInt -> IO ()
adw_flap_set_modal Ptr Flap
self' CInt
modal'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetModalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetModalMethodInfo a signature where
    overloadedMethod = flapSetModal

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


#endif

-- method Flap::set_reveal_flap
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reveal_flap"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to reveal the flap widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether the flap widget is revealed for /@self@/.
flapSetRevealFlap ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Bool
    -- ^ /@revealFlap@/: whether to reveal the flap widget
    -> m ()
flapSetRevealFlap :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> Bool -> m ()
flapSetRevealFlap a
self Bool
revealFlap = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let revealFlap' :: CInt
revealFlap' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
revealFlap
    Ptr Flap -> CInt -> IO ()
adw_flap_set_reveal_flap Ptr Flap
self' CInt
revealFlap'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetRevealFlapMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetRevealFlapMethodInfo a signature where
    overloadedMethod = flapSetRevealFlap

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


#endif

-- method Flap::set_reveal_params
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "SpringParams" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new parameters" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_flap_set_reveal_params" adw_flap_set_reveal_params :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    Ptr Adw.SpringParams.SpringParams ->    -- params : TInterface (Name {namespace = "Adw", name = "SpringParams"})
    IO ()

-- | Sets the reveal animation spring parameters for /@self@/.
-- 
-- The default value is equivalent to:
-- 
-- 
-- === /c code/
-- >adw_spring_params_new (1, 0.5, 500)
flapSetRevealParams ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Adw.SpringParams.SpringParams
    -- ^ /@params@/: the new parameters
    -> m ()
flapSetRevealParams :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> SpringParams -> m ()
flapSetRevealParams a
self SpringParams
params = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr SpringParams
params' <- SpringParams -> IO (Ptr SpringParams)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SpringParams
params
    Ptr Flap -> Ptr SpringParams -> IO ()
adw_flap_set_reveal_params Ptr Flap
self' Ptr SpringParams
params'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    SpringParams -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SpringParams
params
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetRevealParamsMethodInfo
instance (signature ~ (Adw.SpringParams.SpringParams -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetRevealParamsMethodInfo a signature where
    overloadedMethod = flapSetRevealParams

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


#endif

-- method Flap::set_separator
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "separator"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the separator widget"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets the separator widget for /@self@/.
-- 
-- It\'s displayed between content and flap when there\'s no shadow to display.
-- When exactly it\'s visible depends on the [property/@flap@/:transition-type]
-- value.
flapSetSeparator ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a, Gtk.Widget.IsWidget b) =>
    a
    -- ^ /@self@/: a flap
    -> Maybe (b)
    -- ^ /@separator@/: the separator widget
    -> m ()
flapSetSeparator :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFlap a, IsWidget b) =>
a -> Maybe b -> m ()
flapSetSeparator a
self Maybe b
separator = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
maybeSeparator <- case Maybe b
separator of
        Maybe b
Nothing -> Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
forall a. Ptr a
nullPtr
        Just b
jSeparator -> do
            Ptr Widget
jSeparator' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSeparator
            Ptr Widget -> IO (Ptr Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Widget
jSeparator'
    Ptr Flap -> Ptr Widget -> IO ()
adw_flap_set_separator Ptr Flap
self' Ptr Widget
maybeSeparator
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
separator b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetSeparatorMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFlap a, Gtk.Widget.IsWidget b) => O.OverloadedMethod FlapSetSeparatorMethodInfo a signature where
    overloadedMethod = flapSetSeparator

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


#endif

-- method Flap::set_swipe_to_close
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "swipe_to_close"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether @self can be closed with a swipe gesture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether /@self@/ can be closed with a swipe gesture.
-- 
-- The area that can be swiped depends on the [property/@flap@/:transition-type]
-- value.
flapSetSwipeToClose ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Bool
    -- ^ /@swipeToClose@/: whether /@self@/ can be closed with a swipe gesture
    -> m ()
flapSetSwipeToClose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> Bool -> m ()
flapSetSwipeToClose a
self Bool
swipeToClose = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let swipeToClose' :: CInt
swipeToClose' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
swipeToClose
    Ptr Flap -> CInt -> IO ()
adw_flap_set_swipe_to_close Ptr Flap
self' CInt
swipeToClose'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetSwipeToCloseMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetSwipeToCloseMethodInfo a signature where
    overloadedMethod = flapSetSwipeToClose

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


#endif

-- method Flap::set_swipe_to_open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "swipe_to_open"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether @self can be opened with a swipe gesture"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Sets whether /@self@/ can be opened with a swipe gesture.
-- 
-- The area that can be swiped depends on the [property/@flap@/:transition-type]
-- value.
flapSetSwipeToOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Bool
    -- ^ /@swipeToOpen@/: whether /@self@/ can be opened with a swipe gesture
    -> m ()
flapSetSwipeToOpen :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> Bool -> m ()
flapSetSwipeToOpen a
self Bool
swipeToOpen = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let swipeToOpen' :: CInt
swipeToOpen' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
swipeToOpen
    Ptr Flap -> CInt -> IO ()
adw_flap_set_swipe_to_open Ptr Flap
self' CInt
swipeToOpen'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetSwipeToOpenMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetSwipeToOpenMethodInfo a signature where
    overloadedMethod = flapSetSwipeToOpen

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


#endif

-- method Flap::set_transition_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType = TInterface Name { namespace = "Adw" , name = "Flap" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a flap" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "transition_type"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "FlapTransitionType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new transition type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_flap_set_transition_type" adw_flap_set_transition_type :: 
    Ptr Flap ->                             -- self : TInterface (Name {namespace = "Adw", name = "Flap"})
    CUInt ->                                -- transition_type : TInterface (Name {namespace = "Adw", name = "FlapTransitionType"})
    IO ()

-- | Sets the type of animation used for reveal and fold transitions in /@self@/.
-- 
-- [property/@flap@/:flap] is transparent by default, which means the content will
-- be seen through it with @ADW_FLAP_TRANSITION_TYPE_OVER@ transitions; add the
-- <https://gnome.pages.gitlab.gnome.org/libadwaita/doc/main/style-classes.html#background `.background`> style class to it if this is
-- unwanted.
flapSetTransitionType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFlap a) =>
    a
    -- ^ /@self@/: a flap
    -> Adw.Enums.FlapTransitionType
    -- ^ /@transitionType@/: the new transition type
    -> m ()
flapSetTransitionType :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFlap a) =>
a -> FlapTransitionType -> m ()
flapSetTransitionType a
self FlapTransitionType
transitionType = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Flap
self' <- a -> IO (Ptr Flap)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let transitionType' :: CUInt
transitionType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FlapTransitionType -> Int) -> FlapTransitionType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlapTransitionType -> Int
forall a. Enum a => a -> Int
fromEnum) FlapTransitionType
transitionType
    Ptr Flap -> CUInt -> IO ()
adw_flap_set_transition_type Ptr Flap
self' CUInt
transitionType'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FlapSetTransitionTypeMethodInfo
instance (signature ~ (Adw.Enums.FlapTransitionType -> m ()), MonadIO m, IsFlap a) => O.OverloadedMethod FlapSetTransitionTypeMethodInfo a signature where
    overloadedMethod = flapSetTransitionType

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


#endif