{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Asynchronous API to present a file chooser dialog.
-- 
-- @GtkFileDialog@ collects the arguments that are needed to present
-- the dialog to the user, such as a title for the dialog and whether
-- it should be modal.
-- 
-- The dialog is shown with 'GI.Gtk.Objects.FileDialog.fileDialogOpen',
-- 'GI.Gtk.Objects.FileDialog.fileDialogSave', etc.
-- 
-- /Since: 4.10/

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

module GI.Gtk.Objects.FileDialog
    ( 

-- * Exported types
    FileDialog(..)                          ,
    IsFileDialog                            ,
    toFileDialog                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [open]("GI.Gtk.Objects.FileDialog#g:method:open"), [openFinish]("GI.Gtk.Objects.FileDialog#g:method:openFinish"), [openMultiple]("GI.Gtk.Objects.FileDialog#g:method:openMultiple"), [openMultipleFinish]("GI.Gtk.Objects.FileDialog#g:method:openMultipleFinish"), [openMultipleTextFiles]("GI.Gtk.Objects.FileDialog#g:method:openMultipleTextFiles"), [openMultipleTextFilesFinish]("GI.Gtk.Objects.FileDialog#g:method:openMultipleTextFilesFinish"), [openTextFile]("GI.Gtk.Objects.FileDialog#g:method:openTextFile"), [openTextFileFinish]("GI.Gtk.Objects.FileDialog#g:method:openTextFileFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [save]("GI.Gtk.Objects.FileDialog#g:method:save"), [saveFinish]("GI.Gtk.Objects.FileDialog#g:method:saveFinish"), [saveTextFile]("GI.Gtk.Objects.FileDialog#g:method:saveTextFile"), [saveTextFileFinish]("GI.Gtk.Objects.FileDialog#g:method:saveTextFileFinish"), [selectFolder]("GI.Gtk.Objects.FileDialog#g:method:selectFolder"), [selectFolderFinish]("GI.Gtk.Objects.FileDialog#g:method:selectFolderFinish"), [selectMultipleFolders]("GI.Gtk.Objects.FileDialog#g:method:selectMultipleFolders"), [selectMultipleFoldersFinish]("GI.Gtk.Objects.FileDialog#g:method:selectMultipleFoldersFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAcceptLabel]("GI.Gtk.Objects.FileDialog#g:method:getAcceptLabel"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultFilter]("GI.Gtk.Objects.FileDialog#g:method:getDefaultFilter"), [getFilters]("GI.Gtk.Objects.FileDialog#g:method:getFilters"), [getInitialFile]("GI.Gtk.Objects.FileDialog#g:method:getInitialFile"), [getInitialFolder]("GI.Gtk.Objects.FileDialog#g:method:getInitialFolder"), [getInitialName]("GI.Gtk.Objects.FileDialog#g:method:getInitialName"), [getModal]("GI.Gtk.Objects.FileDialog#g:method:getModal"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getTitle]("GI.Gtk.Objects.FileDialog#g:method:getTitle").
-- 
-- ==== Setters
-- [setAcceptLabel]("GI.Gtk.Objects.FileDialog#g:method:setAcceptLabel"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefaultFilter]("GI.Gtk.Objects.FileDialog#g:method:setDefaultFilter"), [setFilters]("GI.Gtk.Objects.FileDialog#g:method:setFilters"), [setInitialFile]("GI.Gtk.Objects.FileDialog#g:method:setInitialFile"), [setInitialFolder]("GI.Gtk.Objects.FileDialog#g:method:setInitialFolder"), [setInitialName]("GI.Gtk.Objects.FileDialog#g:method:setInitialName"), [setModal]("GI.Gtk.Objects.FileDialog#g:method:setModal"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setTitle]("GI.Gtk.Objects.FileDialog#g:method:setTitle").

#if defined(ENABLE_OVERLOADING)
    ResolveFileDialogMethod                 ,
#endif

-- ** getAcceptLabel #method:getAcceptLabel#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetAcceptLabelMethodInfo      ,
#endif
    fileDialogGetAcceptLabel                ,


-- ** getDefaultFilter #method:getDefaultFilter#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetDefaultFilterMethodInfo    ,
#endif
    fileDialogGetDefaultFilter              ,


-- ** getFilters #method:getFilters#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetFiltersMethodInfo          ,
#endif
    fileDialogGetFilters                    ,


-- ** getInitialFile #method:getInitialFile#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetInitialFileMethodInfo      ,
#endif
    fileDialogGetInitialFile                ,


-- ** getInitialFolder #method:getInitialFolder#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetInitialFolderMethodInfo    ,
#endif
    fileDialogGetInitialFolder              ,


-- ** getInitialName #method:getInitialName#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetInitialNameMethodInfo      ,
#endif
    fileDialogGetInitialName                ,


-- ** getModal #method:getModal#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetModalMethodInfo            ,
#endif
    fileDialogGetModal                      ,


-- ** getTitle #method:getTitle#

#if defined(ENABLE_OVERLOADING)
    FileDialogGetTitleMethodInfo            ,
#endif
    fileDialogGetTitle                      ,


-- ** new #method:new#

    fileDialogNew                           ,


-- ** open #method:open#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenMethodInfo                ,
#endif
    fileDialogOpen                          ,


-- ** openFinish #method:openFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenFinishMethodInfo          ,
#endif
    fileDialogOpenFinish                    ,


-- ** openMultiple #method:openMultiple#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenMultipleMethodInfo        ,
#endif
    fileDialogOpenMultiple                  ,


-- ** openMultipleFinish #method:openMultipleFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenMultipleFinishMethodInfo  ,
#endif
    fileDialogOpenMultipleFinish            ,


-- ** openMultipleTextFiles #method:openMultipleTextFiles#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenMultipleTextFilesMethodInfo,
#endif
    fileDialogOpenMultipleTextFiles         ,


-- ** openMultipleTextFilesFinish #method:openMultipleTextFilesFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenMultipleTextFilesFinishMethodInfo,
#endif
    fileDialogOpenMultipleTextFilesFinish   ,


-- ** openTextFile #method:openTextFile#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenTextFileMethodInfo        ,
#endif
    fileDialogOpenTextFile                  ,


-- ** openTextFileFinish #method:openTextFileFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogOpenTextFileFinishMethodInfo  ,
#endif
    fileDialogOpenTextFileFinish            ,


-- ** save #method:save#

#if defined(ENABLE_OVERLOADING)
    FileDialogSaveMethodInfo                ,
#endif
    fileDialogSave                          ,


-- ** saveFinish #method:saveFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogSaveFinishMethodInfo          ,
#endif
    fileDialogSaveFinish                    ,


-- ** saveTextFile #method:saveTextFile#

#if defined(ENABLE_OVERLOADING)
    FileDialogSaveTextFileMethodInfo        ,
#endif
    fileDialogSaveTextFile                  ,


-- ** saveTextFileFinish #method:saveTextFileFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogSaveTextFileFinishMethodInfo  ,
#endif
    fileDialogSaveTextFileFinish            ,


-- ** selectFolder #method:selectFolder#

#if defined(ENABLE_OVERLOADING)
    FileDialogSelectFolderMethodInfo        ,
#endif
    fileDialogSelectFolder                  ,


-- ** selectFolderFinish #method:selectFolderFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogSelectFolderFinishMethodInfo  ,
#endif
    fileDialogSelectFolderFinish            ,


-- ** selectMultipleFolders #method:selectMultipleFolders#

#if defined(ENABLE_OVERLOADING)
    FileDialogSelectMultipleFoldersMethodInfo,
#endif
    fileDialogSelectMultipleFolders         ,


-- ** selectMultipleFoldersFinish #method:selectMultipleFoldersFinish#

#if defined(ENABLE_OVERLOADING)
    FileDialogSelectMultipleFoldersFinishMethodInfo,
#endif
    fileDialogSelectMultipleFoldersFinish   ,


-- ** setAcceptLabel #method:setAcceptLabel#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetAcceptLabelMethodInfo      ,
#endif
    fileDialogSetAcceptLabel                ,


-- ** setDefaultFilter #method:setDefaultFilter#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetDefaultFilterMethodInfo    ,
#endif
    fileDialogSetDefaultFilter              ,


-- ** setFilters #method:setFilters#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetFiltersMethodInfo          ,
#endif
    fileDialogSetFilters                    ,


-- ** setInitialFile #method:setInitialFile#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetInitialFileMethodInfo      ,
#endif
    fileDialogSetInitialFile                ,


-- ** setInitialFolder #method:setInitialFolder#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetInitialFolderMethodInfo    ,
#endif
    fileDialogSetInitialFolder              ,


-- ** setInitialName #method:setInitialName#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetInitialNameMethodInfo      ,
#endif
    fileDialogSetInitialName                ,


-- ** setModal #method:setModal#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetModalMethodInfo            ,
#endif
    fileDialogSetModal                      ,


-- ** setTitle #method:setTitle#

#if defined(ENABLE_OVERLOADING)
    FileDialogSetTitleMethodInfo            ,
#endif
    fileDialogSetTitle                      ,




 -- * Properties


-- ** acceptLabel #attr:acceptLabel#
-- | Label for the file chooser\'s accept button.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogAcceptLabelPropertyInfo       ,
#endif
    clearFileDialogAcceptLabel              ,
    constructFileDialogAcceptLabel          ,
#if defined(ENABLE_OVERLOADING)
    fileDialogAcceptLabel                   ,
#endif
    getFileDialogAcceptLabel                ,
    setFileDialogAcceptLabel                ,


-- ** defaultFilter #attr:defaultFilter#
-- | The default filter.
-- 
-- This filter is initially active in the file chooser dialog.
-- 
-- If the default filter is @NULL@, the first filter of [FileDialog:filters]("GI.Gtk.Objects.FileDialog#g:attr:filters")
-- is used as the default filter. If that property contains no filter, the dialog will
-- be unfiltered.
-- 
-- If [FileDialog:filters]("GI.Gtk.Objects.FileDialog#g:attr:filters") is not @NULL@, the default filter should be
-- part of the list. If it is not, the dialog may choose to not make it available.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogDefaultFilterPropertyInfo     ,
#endif
    clearFileDialogDefaultFilter            ,
    constructFileDialogDefaultFilter        ,
#if defined(ENABLE_OVERLOADING)
    fileDialogDefaultFilter                 ,
#endif
    getFileDialogDefaultFilter              ,
    setFileDialogDefaultFilter              ,


-- ** filters #attr:filters#
-- | The list of filters.
-- 
-- See [FileDialog:defaultFilter]("GI.Gtk.Objects.FileDialog#g:attr:defaultFilter") about how these
-- two properties interact.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogFiltersPropertyInfo           ,
#endif
    clearFileDialogFilters                  ,
    constructFileDialogFilters              ,
#if defined(ENABLE_OVERLOADING)
    fileDialogFilters                       ,
#endif
    getFileDialogFilters                    ,
    setFileDialogFilters                    ,


-- ** initialFile #attr:initialFile#
-- | The initial file.
-- 
-- This file is initially selected in the file chooser dialog
-- 
-- This is a utility property that sets both [FileDialog:initialFolder]("GI.Gtk.Objects.FileDialog#g:attr:initialFolder")
-- and [FileDialog:initialName]("GI.Gtk.Objects.FileDialog#g:attr:initialName").
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogInitialFilePropertyInfo       ,
#endif
    clearFileDialogInitialFile              ,
    constructFileDialogInitialFile          ,
#if defined(ENABLE_OVERLOADING)
    fileDialogInitialFile                   ,
#endif
    getFileDialogInitialFile                ,
    setFileDialogInitialFile                ,


-- ** initialFolder #attr:initialFolder#
-- | The initial folder.
-- 
-- This is the directory that is initially opened in the file chooser dialog.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogInitialFolderPropertyInfo     ,
#endif
    clearFileDialogInitialFolder            ,
    constructFileDialogInitialFolder        ,
#if defined(ENABLE_OVERLOADING)
    fileDialogInitialFolder                 ,
#endif
    getFileDialogInitialFolder              ,
    setFileDialogInitialFolder              ,


-- ** initialName #attr:initialName#
-- | The initial name.
-- 
-- This is the name of the file that is initially selected in the file chooser dialog.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogInitialNamePropertyInfo       ,
#endif
    clearFileDialogInitialName              ,
    constructFileDialogInitialName          ,
#if defined(ENABLE_OVERLOADING)
    fileDialogInitialName                   ,
#endif
    getFileDialogInitialName                ,
    setFileDialogInitialName                ,


-- ** modal #attr:modal#
-- | Whether the file chooser dialog is modal.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogModalPropertyInfo             ,
#endif
    constructFileDialogModal                ,
#if defined(ENABLE_OVERLOADING)
    fileDialogModal                         ,
#endif
    getFileDialogModal                      ,
    setFileDialogModal                      ,


-- ** title #attr:title#
-- | A title that may be shown on the file chooser dialog.
-- 
-- /Since: 4.10/

#if defined(ENABLE_OVERLOADING)
    FileDialogTitlePropertyInfo             ,
#endif
    constructFileDialogTitle                ,
#if defined(ENABLE_OVERLOADING)
    fileDialogTitle                         ,
#endif
    getFileDialogTitle                      ,
    setFileDialogTitle                      ,




    ) where

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

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

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.Cairo.Structs.Context as Cairo.Context
import qualified GI.Cairo.Structs.FontOptions as Cairo.FontOptions
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Objects.Clipboard as Gdk.Clipboard
import qualified GI.Gdk.Objects.Cursor as Gdk.Cursor
import qualified GI.Gdk.Objects.Device as Gdk.Device
import qualified GI.Gdk.Objects.Display as Gdk.Display
import qualified GI.Gdk.Objects.Event as Gdk.Event
import qualified GI.Gdk.Objects.FrameClock as Gdk.FrameClock
import qualified GI.Gdk.Objects.Monitor as Gdk.Monitor
import qualified GI.Gdk.Objects.Snapshot as Gdk.Snapshot
import qualified GI.Gdk.Objects.Surface as Gdk.Surface
import qualified GI.Gdk.Objects.Texture as Gdk.Texture
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.ActionMap as Gio.ActionMap
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Application as Gio.Application
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.Menu as Gio.Menu
import qualified GI.Gio.Objects.MenuModel as Gio.MenuModel
import qualified GI.Graphene.Structs.Matrix as Graphene.Matrix
import qualified GI.Graphene.Structs.Point as Graphene.Point
import qualified GI.Graphene.Structs.Point3D as Graphene.Point3D
import qualified GI.Graphene.Structs.Rect as Graphene.Rect
import qualified GI.Graphene.Structs.Size as Graphene.Size
import qualified GI.Graphene.Structs.Vec3 as Graphene.Vec3
import qualified GI.Graphene.Structs.Vec4 as Graphene.Vec4
import qualified GI.Gsk.Enums as Gsk.Enums
import qualified GI.Gsk.Objects.GLShader as Gsk.GLShader
import qualified GI.Gsk.Objects.RenderNode as Gsk.RenderNode
import qualified GI.Gsk.Objects.Renderer as Gsk.Renderer
import qualified GI.Gsk.Structs.ColorStop as Gsk.ColorStop
import qualified GI.Gsk.Structs.Path as Gsk.Path
import qualified GI.Gsk.Structs.RoundedRect as Gsk.RoundedRect
import qualified GI.Gsk.Structs.Shadow as Gsk.Shadow
import qualified GI.Gsk.Structs.Stroke as Gsk.Stroke
import qualified GI.Gsk.Structs.Transform as Gsk.Transform
import qualified GI.Gtk.Callbacks as Gtk.Callbacks
import {-# SOURCE #-} qualified GI.Gtk.Enums as Gtk.Enums
import {-# SOURCE #-} qualified GI.Gtk.Flags as Gtk.Flags
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Native as Gtk.Native
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.Root as Gtk.Root
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.ShortcutManager as Gtk.ShortcutManager
import {-# SOURCE #-} qualified GI.Gtk.Interfaces.StyleProvider as Gtk.StyleProvider
import {-# SOURCE #-} qualified GI.Gtk.Objects.ATContext as Gtk.ATContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Application as Gtk.Application
import {-# SOURCE #-} qualified GI.Gtk.Objects.EventController as Gtk.EventController
import {-# SOURCE #-} qualified GI.Gtk.Objects.FileFilter as Gtk.FileFilter
import {-# SOURCE #-} qualified GI.Gtk.Objects.Filter as Gtk.Filter
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutChild as Gtk.LayoutChild
import {-# SOURCE #-} qualified GI.Gtk.Objects.LayoutManager as Gtk.LayoutManager
import {-# SOURCE #-} qualified GI.Gtk.Objects.Settings as Gtk.Settings
import {-# SOURCE #-} qualified GI.Gtk.Objects.Snapshot as Gtk.Snapshot
import {-# SOURCE #-} qualified GI.Gtk.Objects.StyleContext as Gtk.StyleContext
import {-# SOURCE #-} qualified GI.Gtk.Objects.Tooltip as Gtk.Tooltip
import {-# SOURCE #-} qualified GI.Gtk.Objects.Widget as Gtk.Widget
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window
import {-# SOURCE #-} qualified GI.Gtk.Objects.WindowGroup as Gtk.WindowGroup
import {-# SOURCE #-} qualified GI.Gtk.Structs.Border as Gtk.Border
import {-# SOURCE #-} qualified GI.Gtk.Structs.Requisition as Gtk.Requisition
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Objects.Context as Pango.Context
import qualified GI.Pango.Objects.FontMap as Pango.FontMap
import qualified GI.Pango.Objects.Layout as Pango.Layout

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gtk.Objects.FileFilter as Gtk.FileFilter
import {-# SOURCE #-} qualified GI.Gtk.Objects.Window as Gtk.Window

#endif

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

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

foreign import ccall "gtk_file_dialog_get_type"
    c_gtk_file_dialog_get_type :: IO B.Types.GType

instance B.Types.TypedObject FileDialog where
    glibType :: IO GType
glibType = IO GType
c_gtk_file_dialog_get_type

instance B.Types.GObject FileDialog

-- | Type class for types which can be safely cast to t'FileDialog', for instance with `toFileDialog`.
class (SP.GObject o, O.IsDescendantOf FileDialog o) => IsFileDialog o
instance (SP.GObject o, O.IsDescendantOf FileDialog o) => IsFileDialog o

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveFileDialogMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveFileDialogMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileDialogMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileDialogMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileDialogMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileDialogMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileDialogMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileDialogMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileDialogMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileDialogMethod "open" o = FileDialogOpenMethodInfo
    ResolveFileDialogMethod "openFinish" o = FileDialogOpenFinishMethodInfo
    ResolveFileDialogMethod "openMultiple" o = FileDialogOpenMultipleMethodInfo
    ResolveFileDialogMethod "openMultipleFinish" o = FileDialogOpenMultipleFinishMethodInfo
    ResolveFileDialogMethod "openMultipleTextFiles" o = FileDialogOpenMultipleTextFilesMethodInfo
    ResolveFileDialogMethod "openMultipleTextFilesFinish" o = FileDialogOpenMultipleTextFilesFinishMethodInfo
    ResolveFileDialogMethod "openTextFile" o = FileDialogOpenTextFileMethodInfo
    ResolveFileDialogMethod "openTextFileFinish" o = FileDialogOpenTextFileFinishMethodInfo
    ResolveFileDialogMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileDialogMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileDialogMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileDialogMethod "save" o = FileDialogSaveMethodInfo
    ResolveFileDialogMethod "saveFinish" o = FileDialogSaveFinishMethodInfo
    ResolveFileDialogMethod "saveTextFile" o = FileDialogSaveTextFileMethodInfo
    ResolveFileDialogMethod "saveTextFileFinish" o = FileDialogSaveTextFileFinishMethodInfo
    ResolveFileDialogMethod "selectFolder" o = FileDialogSelectFolderMethodInfo
    ResolveFileDialogMethod "selectFolderFinish" o = FileDialogSelectFolderFinishMethodInfo
    ResolveFileDialogMethod "selectMultipleFolders" o = FileDialogSelectMultipleFoldersMethodInfo
    ResolveFileDialogMethod "selectMultipleFoldersFinish" o = FileDialogSelectMultipleFoldersFinishMethodInfo
    ResolveFileDialogMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileDialogMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileDialogMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileDialogMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileDialogMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileDialogMethod "getAcceptLabel" o = FileDialogGetAcceptLabelMethodInfo
    ResolveFileDialogMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileDialogMethod "getDefaultFilter" o = FileDialogGetDefaultFilterMethodInfo
    ResolveFileDialogMethod "getFilters" o = FileDialogGetFiltersMethodInfo
    ResolveFileDialogMethod "getInitialFile" o = FileDialogGetInitialFileMethodInfo
    ResolveFileDialogMethod "getInitialFolder" o = FileDialogGetInitialFolderMethodInfo
    ResolveFileDialogMethod "getInitialName" o = FileDialogGetInitialNameMethodInfo
    ResolveFileDialogMethod "getModal" o = FileDialogGetModalMethodInfo
    ResolveFileDialogMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileDialogMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileDialogMethod "getTitle" o = FileDialogGetTitleMethodInfo
    ResolveFileDialogMethod "setAcceptLabel" o = FileDialogSetAcceptLabelMethodInfo
    ResolveFileDialogMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileDialogMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileDialogMethod "setDefaultFilter" o = FileDialogSetDefaultFilterMethodInfo
    ResolveFileDialogMethod "setFilters" o = FileDialogSetFiltersMethodInfo
    ResolveFileDialogMethod "setInitialFile" o = FileDialogSetInitialFileMethodInfo
    ResolveFileDialogMethod "setInitialFolder" o = FileDialogSetInitialFolderMethodInfo
    ResolveFileDialogMethod "setInitialName" o = FileDialogSetInitialNameMethodInfo
    ResolveFileDialogMethod "setModal" o = FileDialogSetModalMethodInfo
    ResolveFileDialogMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileDialogMethod "setTitle" o = FileDialogSetTitleMethodInfo
    ResolveFileDialogMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

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

-- | Set the value of the “@accept-label@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileDialog [ #acceptLabel 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogAcceptLabel :: (MonadIO m, IsFileDialog o) => o -> T.Text -> m ()
setFileDialogAcceptLabel :: forall (m :: * -> *) o.
(MonadIO m, IsFileDialog o) =>
o -> Text -> m ()
setFileDialogAcceptLabel o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accept-label" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@accept-label@” 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' #acceptLabel
-- @
clearFileDialogAcceptLabel :: (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogAcceptLabel :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogAcceptLabel 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"accept-label" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data FileDialogAcceptLabelPropertyInfo
instance AttrInfo FileDialogAcceptLabelPropertyInfo where
    type AttrAllowedOps FileDialogAcceptLabelPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileDialogAcceptLabelPropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogAcceptLabelPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint FileDialogAcceptLabelPropertyInfo = (~) T.Text
    type AttrTransferType FileDialogAcceptLabelPropertyInfo = T.Text
    type AttrGetType FileDialogAcceptLabelPropertyInfo = (Maybe T.Text)
    type AttrLabel FileDialogAcceptLabelPropertyInfo = "accept-label"
    type AttrOrigin FileDialogAcceptLabelPropertyInfo = FileDialog
    attrGet = getFileDialogAcceptLabel
    attrSet = setFileDialogAcceptLabel
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileDialogAcceptLabel
    attrClear = clearFileDialogAcceptLabel
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.acceptLabel"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:acceptLabel"
        })
#endif

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

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

-- | Set the value of the “@default-filter@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileDialog [ #defaultFilter 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogDefaultFilter :: (MonadIO m, IsFileDialog o, Gtk.FileFilter.IsFileFilter a) => o -> a -> m ()
setFileDialogDefaultFilter :: forall (m :: * -> *) o a.
(MonadIO m, IsFileDialog o, IsFileFilter a) =>
o -> a -> m ()
setFileDialogDefaultFilter 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
"default-filter" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@default-filter@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileDialogDefaultFilter :: (IsFileDialog o, MIO.MonadIO m, Gtk.FileFilter.IsFileFilter a) => a -> m (GValueConstruct o)
constructFileDialogDefaultFilter :: forall o (m :: * -> *) a.
(IsFileDialog o, MonadIO m, IsFileFilter a) =>
a -> m (GValueConstruct o)
constructFileDialogDefaultFilter 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
"default-filter" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@default-filter@” 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' #defaultFilter
-- @
clearFileDialogDefaultFilter :: (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogDefaultFilter :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogDefaultFilter 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 FileFilter -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"default-filter" (Maybe FileFilter
forall a. Maybe a
Nothing :: Maybe Gtk.FileFilter.FileFilter)

#if defined(ENABLE_OVERLOADING)
data FileDialogDefaultFilterPropertyInfo
instance AttrInfo FileDialogDefaultFilterPropertyInfo where
    type AttrAllowedOps FileDialogDefaultFilterPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileDialogDefaultFilterPropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogDefaultFilterPropertyInfo = Gtk.FileFilter.IsFileFilter
    type AttrTransferTypeConstraint FileDialogDefaultFilterPropertyInfo = Gtk.FileFilter.IsFileFilter
    type AttrTransferType FileDialogDefaultFilterPropertyInfo = Gtk.FileFilter.FileFilter
    type AttrGetType FileDialogDefaultFilterPropertyInfo = (Maybe Gtk.FileFilter.FileFilter)
    type AttrLabel FileDialogDefaultFilterPropertyInfo = "default-filter"
    type AttrOrigin FileDialogDefaultFilterPropertyInfo = FileDialog
    attrGet = getFileDialogDefaultFilter
    attrSet = setFileDialogDefaultFilter
    attrTransfer _ v = do
        unsafeCastTo Gtk.FileFilter.FileFilter v
    attrConstruct = constructFileDialogDefaultFilter
    attrClear = clearFileDialogDefaultFilter
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.defaultFilter"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:defaultFilter"
        })
#endif

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

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

-- | Set the value of the “@filters@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileDialog [ #filters 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogFilters :: (MonadIO m, IsFileDialog o, Gio.ListModel.IsListModel a) => o -> a -> m ()
setFileDialogFilters :: forall (m :: * -> *) o a.
(MonadIO m, IsFileDialog o, IsListModel a) =>
o -> a -> m ()
setFileDialogFilters 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
"filters" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@filters@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileDialogFilters :: (IsFileDialog o, MIO.MonadIO m, Gio.ListModel.IsListModel a) => a -> m (GValueConstruct o)
constructFileDialogFilters :: forall o (m :: * -> *) a.
(IsFileDialog o, MonadIO m, IsListModel a) =>
a -> m (GValueConstruct o)
constructFileDialogFilters 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
"filters" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@filters@” 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' #filters
-- @
clearFileDialogFilters :: (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogFilters :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogFilters 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 ListModel -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"filters" (Maybe ListModel
forall a. Maybe a
Nothing :: Maybe Gio.ListModel.ListModel)

#if defined(ENABLE_OVERLOADING)
data FileDialogFiltersPropertyInfo
instance AttrInfo FileDialogFiltersPropertyInfo where
    type AttrAllowedOps FileDialogFiltersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileDialogFiltersPropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogFiltersPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferTypeConstraint FileDialogFiltersPropertyInfo = Gio.ListModel.IsListModel
    type AttrTransferType FileDialogFiltersPropertyInfo = Gio.ListModel.ListModel
    type AttrGetType FileDialogFiltersPropertyInfo = (Maybe Gio.ListModel.ListModel)
    type AttrLabel FileDialogFiltersPropertyInfo = "filters"
    type AttrOrigin FileDialogFiltersPropertyInfo = FileDialog
    attrGet = getFileDialogFilters
    attrSet = setFileDialogFilters
    attrTransfer _ v = do
        unsafeCastTo Gio.ListModel.ListModel v
    attrConstruct = constructFileDialogFilters
    attrClear = clearFileDialogFilters
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.filters"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:filters"
        })
#endif

-- VVV Prop "initial-file"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@initial-file@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileDialog [ #initialFile 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogInitialFile :: (MonadIO m, IsFileDialog o, Gio.File.IsFile a) => o -> a -> m ()
setFileDialogInitialFile :: forall (m :: * -> *) o a.
(MonadIO m, IsFileDialog o, IsFile a) =>
o -> a -> m ()
setFileDialogInitialFile 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
"initial-file" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@initial-file@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileDialogInitialFile :: (IsFileDialog o, MIO.MonadIO m, Gio.File.IsFile a) => a -> m (GValueConstruct o)
constructFileDialogInitialFile :: forall o (m :: * -> *) a.
(IsFileDialog o, MonadIO m, IsFile a) =>
a -> m (GValueConstruct o)
constructFileDialogInitialFile 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
"initial-file" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@initial-file@” 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' #initialFile
-- @
clearFileDialogInitialFile :: (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogInitialFile :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogInitialFile 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 File -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"initial-file" (Maybe File
forall a. Maybe a
Nothing :: Maybe Gio.File.File)

#if defined(ENABLE_OVERLOADING)
data FileDialogInitialFilePropertyInfo
instance AttrInfo FileDialogInitialFilePropertyInfo where
    type AttrAllowedOps FileDialogInitialFilePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileDialogInitialFilePropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogInitialFilePropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint FileDialogInitialFilePropertyInfo = Gio.File.IsFile
    type AttrTransferType FileDialogInitialFilePropertyInfo = Gio.File.File
    type AttrGetType FileDialogInitialFilePropertyInfo = (Maybe Gio.File.File)
    type AttrLabel FileDialogInitialFilePropertyInfo = "initial-file"
    type AttrOrigin FileDialogInitialFilePropertyInfo = FileDialog
    attrGet = getFileDialogInitialFile
    attrSet = setFileDialogInitialFile
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructFileDialogInitialFile
    attrClear = clearFileDialogInitialFile
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.initialFile"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:initialFile"
        })
#endif

-- VVV Prop "initial-folder"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just True,Just True)

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

-- | Set the value of the “@initial-folder@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileDialog [ #initialFolder 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogInitialFolder :: (MonadIO m, IsFileDialog o, Gio.File.IsFile a) => o -> a -> m ()
setFileDialogInitialFolder :: forall (m :: * -> *) o a.
(MonadIO m, IsFileDialog o, IsFile a) =>
o -> a -> m ()
setFileDialogInitialFolder 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
"initial-folder" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a t'GValueConstruct' with valid value for the “@initial-folder@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileDialogInitialFolder :: (IsFileDialog o, MIO.MonadIO m, Gio.File.IsFile a) => a -> m (GValueConstruct o)
constructFileDialogInitialFolder :: forall o (m :: * -> *) a.
(IsFileDialog o, MonadIO m, IsFile a) =>
a -> m (GValueConstruct o)
constructFileDialogInitialFolder 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
"initial-folder" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@initial-folder@” 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' #initialFolder
-- @
clearFileDialogInitialFolder :: (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogInitialFolder :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogInitialFolder 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 File -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"initial-folder" (Maybe File
forall a. Maybe a
Nothing :: Maybe Gio.File.File)

#if defined(ENABLE_OVERLOADING)
data FileDialogInitialFolderPropertyInfo
instance AttrInfo FileDialogInitialFolderPropertyInfo where
    type AttrAllowedOps FileDialogInitialFolderPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileDialogInitialFolderPropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogInitialFolderPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint FileDialogInitialFolderPropertyInfo = Gio.File.IsFile
    type AttrTransferType FileDialogInitialFolderPropertyInfo = Gio.File.File
    type AttrGetType FileDialogInitialFolderPropertyInfo = (Maybe Gio.File.File)
    type AttrLabel FileDialogInitialFolderPropertyInfo = "initial-folder"
    type AttrOrigin FileDialogInitialFolderPropertyInfo = FileDialog
    attrGet = getFileDialogInitialFolder
    attrSet = setFileDialogInitialFolder
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructFileDialogInitialFolder
    attrClear = clearFileDialogInitialFolder
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.initialFolder"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:initialFolder"
        })
#endif

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

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

-- | Set the value of the “@initial-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' fileDialog [ #initialName 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogInitialName :: (MonadIO m, IsFileDialog o) => o -> T.Text -> m ()
setFileDialogInitialName :: forall (m :: * -> *) o.
(MonadIO m, IsFileDialog o) =>
o -> Text -> m ()
setFileDialogInitialName o
obj Text
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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"initial-name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

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

-- | Set the value of the “@initial-name@” 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' #initialName
-- @
clearFileDialogInitialName :: (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogInitialName :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m ()
clearFileDialogInitialName 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 Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"initial-name" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data FileDialogInitialNamePropertyInfo
instance AttrInfo FileDialogInitialNamePropertyInfo where
    type AttrAllowedOps FileDialogInitialNamePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint FileDialogInitialNamePropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogInitialNamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint FileDialogInitialNamePropertyInfo = (~) T.Text
    type AttrTransferType FileDialogInitialNamePropertyInfo = T.Text
    type AttrGetType FileDialogInitialNamePropertyInfo = (Maybe T.Text)
    type AttrLabel FileDialogInitialNamePropertyInfo = "initial-name"
    type AttrOrigin FileDialogInitialNamePropertyInfo = FileDialog
    attrGet = getFileDialogInitialName
    attrSet = setFileDialogInitialName
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileDialogInitialName
    attrClear = clearFileDialogInitialName
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.initialName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:initialName"
        })
#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' fileDialog #modal
-- @
getFileDialogModal :: (MonadIO m, IsFileDialog o) => o -> m Bool
getFileDialogModal :: forall (m :: * -> *) o. (MonadIO m, IsFileDialog o) => o -> m Bool
getFileDialogModal 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' fileDialog [ #modal 'Data.GI.Base.Attributes.:=' value ]
-- @
setFileDialogModal :: (MonadIO m, IsFileDialog o) => o -> Bool -> m ()
setFileDialogModal :: forall (m :: * -> *) o.
(MonadIO m, IsFileDialog o) =>
o -> Bool -> m ()
setFileDialogModal 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 t'GValueConstruct' with valid value for the “@modal@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructFileDialogModal :: (IsFileDialog o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructFileDialogModal :: forall o (m :: * -> *).
(IsFileDialog o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructFileDialogModal 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 FileDialogModalPropertyInfo
instance AttrInfo FileDialogModalPropertyInfo where
    type AttrAllowedOps FileDialogModalPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FileDialogModalPropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogModalPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint FileDialogModalPropertyInfo = (~) Bool
    type AttrTransferType FileDialogModalPropertyInfo = Bool
    type AttrGetType FileDialogModalPropertyInfo = Bool
    type AttrLabel FileDialogModalPropertyInfo = "modal"
    type AttrOrigin FileDialogModalPropertyInfo = FileDialog
    attrGet = getFileDialogModal
    attrSet = setFileDialogModal
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileDialogModal
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.modal"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:modal"
        })
#endif

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

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

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

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

#if defined(ENABLE_OVERLOADING)
data FileDialogTitlePropertyInfo
instance AttrInfo FileDialogTitlePropertyInfo where
    type AttrAllowedOps FileDialogTitlePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint FileDialogTitlePropertyInfo = IsFileDialog
    type AttrSetTypeConstraint FileDialogTitlePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint FileDialogTitlePropertyInfo = (~) T.Text
    type AttrTransferType FileDialogTitlePropertyInfo = T.Text
    type AttrGetType FileDialogTitlePropertyInfo = T.Text
    type AttrLabel FileDialogTitlePropertyInfo = "title"
    type AttrOrigin FileDialogTitlePropertyInfo = FileDialog
    attrGet = getFileDialogTitle
    attrSet = setFileDialogTitle
    attrTransfer _ v = do
        return v
    attrConstruct = constructFileDialogTitle
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.title"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#g:attr:title"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FileDialog
type instance O.AttributeList FileDialog = FileDialogAttributeList
type FileDialogAttributeList = ('[ '("acceptLabel", FileDialogAcceptLabelPropertyInfo), '("defaultFilter", FileDialogDefaultFilterPropertyInfo), '("filters", FileDialogFiltersPropertyInfo), '("initialFile", FileDialogInitialFilePropertyInfo), '("initialFolder", FileDialogInitialFolderPropertyInfo), '("initialName", FileDialogInitialNamePropertyInfo), '("modal", FileDialogModalPropertyInfo), '("title", FileDialogTitlePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
fileDialogAcceptLabel :: AttrLabelProxy "acceptLabel"
fileDialogAcceptLabel = AttrLabelProxy

fileDialogDefaultFilter :: AttrLabelProxy "defaultFilter"
fileDialogDefaultFilter = AttrLabelProxy

fileDialogFilters :: AttrLabelProxy "filters"
fileDialogFilters = AttrLabelProxy

fileDialogInitialFile :: AttrLabelProxy "initialFile"
fileDialogInitialFile = AttrLabelProxy

fileDialogInitialFolder :: AttrLabelProxy "initialFolder"
fileDialogInitialFolder = AttrLabelProxy

fileDialogInitialName :: AttrLabelProxy "initialName"
fileDialogInitialName = AttrLabelProxy

fileDialogModal :: AttrLabelProxy "modal"
fileDialogModal = AttrLabelProxy

fileDialogTitle :: AttrLabelProxy "title"
fileDialogTitle = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "gtk_file_dialog_new" gtk_file_dialog_new :: 
    IO (Ptr FileDialog)

-- | Creates a new @GtkFileDialog@ object.
-- 
-- /Since: 4.10/
fileDialogNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m FileDialog
    -- ^ __Returns:__ the new @GtkFileDialog@
fileDialogNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m FileDialog
fileDialogNew  = IO FileDialog -> m FileDialog
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileDialog -> m FileDialog) -> IO FileDialog -> m FileDialog
forall a b. (a -> b) -> a -> b
$ do
    result <- IO (Ptr FileDialog)
gtk_file_dialog_new
    checkUnexpectedReturnNULL "fileDialogNew" result
    result' <- (wrapObject FileDialog) result
    return result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "gtk_file_dialog_get_accept_label" gtk_file_dialog_get_accept_label :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO CString

-- | Retrieves the text used by the dialog on its accept button.
-- 
-- /Since: 4.10/
fileDialogGetAcceptLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the label shown on the file chooser\'s accept button
fileDialogGetAcceptLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m (Maybe Text)
fileDialogGetAcceptLabel a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_accept_label self'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileDialogGetAcceptLabelMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetAcceptLabelMethodInfo a signature where
    overloadedMethod = fileDialogGetAcceptLabel

instance O.OverloadedMethodInfo FileDialogGetAcceptLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetAcceptLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetAcceptLabel"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_default_filter" gtk_file_dialog_get_default_filter :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO (Ptr Gtk.FileFilter.FileFilter)

-- | Gets the filter that will be selected by default
-- in the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogGetDefaultFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m (Maybe Gtk.FileFilter.FileFilter)
    -- ^ __Returns:__ the default filter
fileDialogGetDefaultFilter :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m (Maybe FileFilter)
fileDialogGetDefaultFilter a
self = IO (Maybe FileFilter) -> m (Maybe FileFilter)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileFilter) -> m (Maybe FileFilter))
-> IO (Maybe FileFilter) -> m (Maybe FileFilter)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_default_filter self'
    maybeResult <- convertIfNonNull result $ \Ptr FileFilter
result' -> do
        result'' <- ((ManagedPtr FileFilter -> FileFilter)
-> Ptr FileFilter -> IO FileFilter
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr FileFilter -> FileFilter
Gtk.FileFilter.FileFilter) Ptr FileFilter
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileDialogGetDefaultFilterMethodInfo
instance (signature ~ (m (Maybe Gtk.FileFilter.FileFilter)), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetDefaultFilterMethodInfo a signature where
    overloadedMethod = fileDialogGetDefaultFilter

instance O.OverloadedMethodInfo FileDialogGetDefaultFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetDefaultFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetDefaultFilter"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_filters" gtk_file_dialog_get_filters :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO (Ptr Gio.ListModel.ListModel)

-- | Gets the filters that will be offered to the user
-- in the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogGetFilters ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ the filters,
    --   as a list model of t'GI.Gtk.Objects.FileFilter.FileFilter'
fileDialogGetFilters :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m (Maybe ListModel)
fileDialogGetFilters a
self = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_filters self'
    maybeResult <- convertIfNonNull result $ \Ptr ListModel
result' -> do
        result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileDialogGetFiltersMethodInfo
instance (signature ~ (m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetFiltersMethodInfo a signature where
    overloadedMethod = fileDialogGetFilters

instance O.OverloadedMethodInfo FileDialogGetFiltersMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetFilters",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetFilters"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_initial_file" gtk_file_dialog_get_initial_file :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO (Ptr Gio.File.File)

-- | Gets the file that will be initially selected in
-- the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogGetInitialFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the file
fileDialogGetInitialFile :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m (Maybe File)
fileDialogGetInitialFile a
self = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_initial_file self'
    maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
        result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileDialogGetInitialFileMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetInitialFileMethodInfo a signature where
    overloadedMethod = fileDialogGetInitialFile

instance O.OverloadedMethodInfo FileDialogGetInitialFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetInitialFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetInitialFile"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_initial_folder" gtk_file_dialog_get_initial_folder :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO (Ptr Gio.File.File)

-- | Gets the folder that will be set as the
-- initial folder in the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogGetInitialFolder ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the folder
fileDialogGetInitialFolder :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m (Maybe File)
fileDialogGetInitialFolder a
self = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_initial_folder self'
    maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
        result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileDialogGetInitialFolderMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetInitialFolderMethodInfo a signature where
    overloadedMethod = fileDialogGetInitialFolder

instance O.OverloadedMethodInfo FileDialogGetInitialFolderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetInitialFolder",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetInitialFolder"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_initial_name" gtk_file_dialog_get_initial_name :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO CString

-- | Gets the filename that will be initially selected.
-- 
-- /Since: 4.10/
fileDialogGetInitialName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name
fileDialogGetInitialName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m (Maybe Text)
fileDialogGetInitialName a
self = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_initial_name self'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr self
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data FileDialogGetInitialNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetInitialNameMethodInfo a signature where
    overloadedMethod = fileDialogGetInitialName

instance O.OverloadedMethodInfo FileDialogGetInitialNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetInitialName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetInitialName"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_modal" gtk_file_dialog_get_modal :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO CInt

-- | Returns whether the file chooser dialog blocks interaction
-- with the parent window while it is presented.
-- 
-- /Since: 4.10/
fileDialogGetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m Bool
    -- ^ __Returns:__ true if the file chooser dialog is modal
fileDialogGetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m Bool
fileDialogGetModal 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_modal self'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data FileDialogGetModalMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetModalMethodInfo a signature where
    overloadedMethod = fileDialogGetModal

instance O.OverloadedMethodInfo FileDialogGetModalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetModal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetModal"
        })


#endif

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

foreign import ccall "gtk_file_dialog_get_title" gtk_file_dialog_get_title :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    IO CString

-- | Returns the title that will be shown on the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogGetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> m T.Text
    -- ^ __Returns:__ the title
fileDialogGetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> m Text
fileDialogGetTitle a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result <- gtk_file_dialog_get_title self'
    checkUnexpectedReturnNULL "fileDialogGetTitle" result
    result' <- cstringToText result
    touchManagedPtr self
    return result'

#if defined(ENABLE_OVERLOADING)
data FileDialogGetTitleMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogGetTitleMethodInfo a signature where
    overloadedMethod = fileDialogGetTitle

instance O.OverloadedMethodInfo FileDialogGetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogGetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogGetTitle"
        })


#endif

-- method FileDialog::open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_open" gtk_file_dialog_open :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Presents a file chooser dialog to the user.
-- 
-- The file chooser dialog will be set up to select a single file.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.10/
fileDialogOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogOpen :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogOpen a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_open self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogOpenMethodInfo a signature where
    overloadedMethod = fileDialogOpen

instance O.OverloadedMethodInfo FileDialogOpenMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpen"
        })


#endif

-- method FileDialog::open_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_finish" gtk_file_dialog_open_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.File.File)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogOpen' call.
-- 
-- /Since: 4.10/
fileDialogOpenFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a file dialog
    -> b
    -- ^ /@result@/: the result
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the file that was selected /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogOpenFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe File)
fileDialogOpenFinish a
self b
result_ = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_file_dialog_open_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
            result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenFinishMethodInfo
instance (signature ~ (b -> m (Maybe Gio.File.File)), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogOpenFinishMethodInfo a signature where
    overloadedMethod = fileDialogOpenFinish

instance O.OverloadedMethodInfo FileDialogOpenFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenFinish"
        })


#endif

-- method FileDialog::open_multiple
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_multiple" gtk_file_dialog_open_multiple :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Presents a file chooser dialog to the user.
-- 
-- The file chooser dialog will be set up to select multiple files.
-- 
-- The file chooser dialog will initially be opened in the directory
-- [FileDialog:initialFolder]("GI.Gtk.Objects.FileDialog#g:attr:initialFolder").
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.10/
fileDialogOpenMultiple ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogOpenMultiple :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogOpenMultiple a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_open_multiple self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenMultipleMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogOpenMultipleMethodInfo a signature where
    overloadedMethod = fileDialogOpenMultiple

instance O.OverloadedMethodInfo FileDialogOpenMultipleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenMultiple",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenMultiple"
        })


#endif

-- method FileDialog::open_multiple_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_multiple_finish" gtk_file_dialog_open_multiple_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.ListModel.ListModel)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogOpen' call.
-- 
-- /Since: 4.10/
fileDialogOpenMultipleFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a file dialog
    -> b
    -- ^ /@result@/: the result
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ the files that were selected,
    --   as a list model of t'GI.Gio.Interfaces.File.File' /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogOpenMultipleFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe ListModel)
fileDialogOpenMultipleFinish a
self b
result_ = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_file_dialog_open_multiple_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr ListModel
result' -> do
            result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenMultipleFinishMethodInfo
instance (signature ~ (b -> m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogOpenMultipleFinishMethodInfo a signature where
    overloadedMethod = fileDialogOpenMultipleFinish

instance O.OverloadedMethodInfo FileDialogOpenMultipleFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenMultipleFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenMultipleFinish"
        })


#endif

-- method FileDialog::open_multiple_text_files
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_multiple_text_files" gtk_file_dialog_open_multiple_text_files :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Presents a file chooser dialog to the user.
-- 
-- The file chooser dialog will be set up to select multiple files.
-- 
-- The file chooser dialog will initially be opened in the directory
-- [FileDialog:initialFolder]("GI.Gtk.Objects.FileDialog#g:attr:initialFolder").
-- 
-- In contrast to 'GI.Gtk.Objects.FileDialog.fileDialogOpen', this function
-- lets the user select the text encoding for the files, if possible.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.18/
fileDialogOpenMultipleTextFiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogOpenMultipleTextFiles :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogOpenMultipleTextFiles a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_open_multiple_text_files self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenMultipleTextFilesMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogOpenMultipleTextFilesMethodInfo a signature where
    overloadedMethod = fileDialogOpenMultipleTextFiles

instance O.OverloadedMethodInfo FileDialogOpenMultipleTextFilesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenMultipleTextFiles",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenMultipleTextFiles"
        })


#endif

-- method FileDialog::open_multiple_text_files_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the text encoding to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_multiple_text_files_finish" gtk_file_dialog_open_multiple_text_files_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CString ->                          -- encoding : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.ListModel.ListModel)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogOpen' call.
-- 
-- /Since: 4.18/
fileDialogOpenMultipleTextFilesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a file dialog
    -> b
    -- ^ /@result@/: the result
    -> m ((Maybe Gio.ListModel.ListModel, T.Text))
    -- ^ __Returns:__ the files that were selected,
    --   as a list model of t'GI.Gio.Interfaces.File.File' /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogOpenMultipleTextFilesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe ListModel, Text)
fileDialogOpenMultipleTextFilesFinish a
self b
result_ = IO (Maybe ListModel, Text) -> m (Maybe ListModel, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel, Text) -> m (Maybe ListModel, Text))
-> IO (Maybe ListModel, Text) -> m (Maybe ListModel, Text)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    encoding <- callocMem :: IO (Ptr CString)
    onException (do
        result <- propagateGError $ gtk_file_dialog_open_multiple_text_files_finish self' result_' encoding
        maybeResult <- convertIfNonNull result $ \Ptr ListModel
result' -> do
            result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
            return result''
        encoding' <- peek encoding
        encoding'' <- cstringToText encoding'
        touchManagedPtr self
        touchManagedPtr result_
        freeMem encoding
        return (maybeResult, encoding'')
     ) (do
        freeMem encoding
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenMultipleTextFilesFinishMethodInfo
instance (signature ~ (b -> m ((Maybe Gio.ListModel.ListModel, T.Text))), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogOpenMultipleTextFilesFinishMethodInfo a signature where
    overloadedMethod = fileDialogOpenMultipleTextFilesFinish

instance O.OverloadedMethodInfo FileDialogOpenMultipleTextFilesFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenMultipleTextFilesFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenMultipleTextFilesFinish"
        })


#endif

-- method FileDialog::open_text_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_text_file" gtk_file_dialog_open_text_file :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Initiates a file selection operation by presenting a file chooser
-- dialog to the user.
-- 
-- In contrast to 'GI.Gtk.Objects.FileDialog.fileDialogOpen', this function
-- lets the user select the text encoding for the file, if possible.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.18/
fileDialogOpenTextFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (c)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogOpenTextFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogOpenTextFile a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_open_text_file self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenTextFileMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogOpenTextFileMethodInfo a signature where
    overloadedMethod = fileDialogOpenTextFile

instance O.OverloadedMethodInfo FileDialogOpenTextFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenTextFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenTextFile"
        })


#endif

-- method FileDialog::open_text_file_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the text encoding to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_open_text_file_finish" gtk_file_dialog_open_text_file_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CString ->                          -- encoding : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.File.File)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogOpenTextFile' call
-- and returns the resulting file and text encoding.
-- 
-- If the user has explicitly selected a text encoding to use
-- for the file, then /@encoding@/ will be set to a codeset name that
-- is suitable for passing to @/iconv_open()/@. Otherwise, it will
-- be @NULL@.
-- 
-- /Since: 4.18/
fileDialogOpenTextFileFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m ((Maybe Gio.File.File, T.Text))
    -- ^ __Returns:__ the file that was selected /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogOpenTextFileFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe File, Text)
fileDialogOpenTextFileFinish a
self b
result_ = IO (Maybe File, Text) -> m (Maybe File, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File, Text) -> m (Maybe File, Text))
-> IO (Maybe File, Text) -> m (Maybe File, Text)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    encoding <- callocMem :: IO (Ptr CString)
    onException (do
        result <- propagateGError $ gtk_file_dialog_open_text_file_finish self' result_' encoding
        maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
            result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
            return result''
        encoding' <- peek encoding
        encoding'' <- cstringToText encoding'
        touchManagedPtr self
        touchManagedPtr result_
        freeMem encoding
        return (maybeResult, encoding'')
     ) (do
        freeMem encoding
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogOpenTextFileFinishMethodInfo
instance (signature ~ (b -> m ((Maybe Gio.File.File, T.Text))), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogOpenTextFileFinishMethodInfo a signature where
    overloadedMethod = fileDialogOpenTextFileFinish

instance O.OverloadedMethodInfo FileDialogOpenTextFileFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogOpenTextFileFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenTextFileFinish"
        })


#endif

-- method FileDialog::save
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_save" gtk_file_dialog_save :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Presents a file chooser dialog to the user.
-- 
-- The file chooser dialog will be save mode.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.10/
fileDialogSave ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogSave :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogSave a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_save self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSaveMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogSaveMethodInfo a signature where
    overloadedMethod = fileDialogSave

instance O.OverloadedMethodInfo FileDialogSaveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSave",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSave"
        })


#endif

-- method FileDialog::save_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_save_finish" gtk_file_dialog_save_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.File.File)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogSave' call.
-- 
-- /Since: 4.10/
fileDialogSaveFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a file dialog
    -> b
    -- ^ /@result@/: the result
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the file that was selected /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogSaveFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe File)
fileDialogSaveFinish a
self b
result_ = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_file_dialog_save_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
            result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogSaveFinishMethodInfo
instance (signature ~ (b -> m (Maybe Gio.File.File)), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogSaveFinishMethodInfo a signature where
    overloadedMethod = fileDialogSaveFinish

instance O.OverloadedMethodInfo FileDialogSaveFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSaveFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSaveFinish"
        })


#endif

-- method FileDialog::save_text_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent `GtkWindow`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GCancellable` to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_save_text_file" gtk_file_dialog_save_text_file :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Initiates a file save operation by presenting a file chooser
-- dialog to the user.
-- 
-- In contrast to 'GI.Gtk.Objects.FileDialog.fileDialogSave', this function
-- lets the user select the text encoding and line endings for
-- the text file, if possible.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.18/
fileDialogSaveTextFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> Maybe (b)
    -- ^ /@parent@/: the parent @GtkWindow@
    -> Maybe (c)
    -- ^ /@cancellable@/: a @GCancellable@ to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogSaveTextFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogSaveTextFile a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_save_text_file self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSaveTextFileMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogSaveTextFileMethodInfo a signature where
    overloadedMethod = fileDialogSaveTextFile

instance O.OverloadedMethodInfo FileDialogSaveTextFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSaveTextFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSaveTextFile"
        })


#endif

-- method FileDialog::save_text_file_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GAsyncResult`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "encoding"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the text encoding to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_ending"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the line endings to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_save_text_file_finish" gtk_file_dialog_save_text_file_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CString ->                          -- encoding : TBasicType TUTF8
    Ptr CString ->                          -- line_ending : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.File.File)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogSaveTextFile' call
-- and returns the resulting file, text encoding and line endings.
-- 
-- If the user has explicitly selected a text encoding to use
-- for the file, then /@encoding@/ will be set to a codeset name that
-- is suitable for passing to @/iconv_open()/@. Otherwise, it will
-- be @NULL@.
-- 
-- The /@lineEnding@/ will be set to one of \"\\n\", \"\\r\\n\", \"\\r\" or \"\",
-- where the latter means to preserve existing line endings.
-- 
-- /Since: 4.18/
fileDialogSaveTextFileFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m ((Maybe Gio.File.File, T.Text, T.Text))
    -- ^ __Returns:__ the file that was selected.
    --   Otherwise, @NULL@ is returned and /@error@/ is set /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogSaveTextFileFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe File, Text, Text)
fileDialogSaveTextFileFinish a
self b
result_ = IO (Maybe File, Text, Text) -> m (Maybe File, Text, Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File, Text, Text) -> m (Maybe File, Text, Text))
-> IO (Maybe File, Text, Text) -> m (Maybe File, Text, Text)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    encoding <- callocMem :: IO (Ptr CString)
    lineEnding <- callocMem :: IO (Ptr CString)
    onException (do
        result <- propagateGError $ gtk_file_dialog_save_text_file_finish self' result_' encoding lineEnding
        maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
            result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
            return result''
        encoding' <- peek encoding
        encoding'' <- cstringToText encoding'
        lineEnding' <- peek lineEnding
        lineEnding'' <- cstringToText lineEnding'
        touchManagedPtr self
        touchManagedPtr result_
        freeMem encoding
        freeMem lineEnding
        return (maybeResult, encoding'', lineEnding'')
     ) (do
        freeMem encoding
        freeMem lineEnding
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogSaveTextFileFinishMethodInfo
instance (signature ~ (b -> m ((Maybe Gio.File.File, T.Text, T.Text))), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogSaveTextFileFinishMethodInfo a signature where
    overloadedMethod = fileDialogSaveTextFileFinish

instance O.OverloadedMethodInfo FileDialogSaveTextFileFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSaveTextFileFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSaveTextFileFinish"
        })


#endif

-- method FileDialog::select_folder
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_select_folder" gtk_file_dialog_select_folder :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Presents a file chooser dialog to the user.
-- 
-- The file chooser dialog will be set up to select a single folder.
-- 
-- If you pass /@initialFolder@/, the file chooser dialog will initially
-- be opened in the parent directory of that folder, otherwise, it
-- will be in the directory [FileDialog:initialFolder]("GI.Gtk.Objects.FileDialog#g:attr:initialFolder").
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.10/
fileDialogSelectFolder ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogSelectFolder :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogSelectFolder a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_select_folder self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSelectFolderMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogSelectFolderMethodInfo a signature where
    overloadedMethod = fileDialogSelectFolder

instance O.OverloadedMethodInfo FileDialogSelectFolderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSelectFolder",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSelectFolder"
        })


#endif

-- method FileDialog::select_folder_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_select_folder_finish" gtk_file_dialog_select_folder_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.File.File)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogSelectFolder' call.
-- 
-- /Since: 4.10/
fileDialogSelectFolderFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a file dialog
    -> b
    -- ^ /@result@/: the result
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the folder that was selected /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogSelectFolderFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe File)
fileDialogSelectFolderFinish a
self b
result_ = IO (Maybe File) -> m (Maybe File)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_file_dialog_select_folder_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr File
result' -> do
            result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogSelectFolderFinishMethodInfo
instance (signature ~ (b -> m (Maybe Gio.File.File)), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogSelectFolderFinishMethodInfo a signature where
    overloadedMethod = fileDialogSelectFolderFinish

instance O.OverloadedMethodInfo FileDialogSelectFolderFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSelectFolderFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSelectFolderFinish"
        })


#endif

-- method FileDialog::select_multiple_folders
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Window" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent window" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a cancellable to cancel the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a callback to call when the\n  operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_select_multiple_folders" gtk_file_dialog_select_multiple_folders :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.Window.Window ->                -- parent : TInterface (Name {namespace = "Gtk", name = "Window"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Presents a file chooser dialog to the user.
-- 
-- The file chooser dialog will be set up to allow selecting
-- multiple folders.
-- 
-- The file chooser dialog will initially be opened in the
-- directory [FileDialog:initialFolder]("GI.Gtk.Objects.FileDialog#g:attr:initialFolder").
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- 
-- /Since: 4.10/
fileDialogSelectMultipleFolders ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@parent@/: the parent window
    -> Maybe (c)
    -- ^ /@cancellable@/: a cancellable to cancel the operation
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a callback to call when the
    --   operation is complete
    -> m ()
fileDialogSelectMultipleFolders :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFileDialog a, IsWindow b,
 IsCancellable c) =>
a -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
fileDialogSelectMultipleFolders a
self Maybe b
parent Maybe c
cancellable Maybe AsyncReadyCallback
callback = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeParent <- case parent of
        Maybe b
Nothing -> Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
forall a. Ptr a
FP.nullPtr
        Just b
jParent -> do
            jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            return jParent'
    maybeCancellable <- case cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just c
jCancellable -> do
            jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    gtk_file_dialog_select_multiple_folders self' maybeParent maybeCancellable maybeCallback userData
    touchManagedPtr self
    whenJust parent touchManagedPtr
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSelectMultipleFoldersMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFileDialog a, Gtk.Window.IsWindow b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileDialogSelectMultipleFoldersMethodInfo a signature where
    overloadedMethod = fileDialogSelectMultipleFolders

instance O.OverloadedMethodInfo FileDialogSelectMultipleFoldersMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSelectMultipleFolders",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSelectMultipleFolders"
        })


#endif

-- method FileDialog::select_multiple_folders_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "ListModel" })
-- throws : True
-- Skip return : False

foreign import ccall "gtk_file_dialog_select_multiple_folders_finish" gtk_file_dialog_select_multiple_folders_finish :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.ListModel.ListModel)

-- | Finishes the 'GI.Gtk.Objects.FileDialog.fileDialogSelectMultipleFolders' call.
-- 
-- /Since: 4.10/
fileDialogSelectMultipleFoldersFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a file dialog
    -> b
    -- ^ /@result@/: the result
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ the folders that were selected,
    --   as a list model of t'GI.Gio.Interfaces.File.File' /(Can throw 'Data.GI.Base.GError.GError')/
fileDialogSelectMultipleFoldersFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsAsyncResult b) =>
a -> b -> m (Maybe ListModel)
fileDialogSelectMultipleFoldersFinish a
self b
result_ = IO (Maybe ListModel) -> m (Maybe ListModel)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ListModel) -> m (Maybe ListModel))
-> IO (Maybe ListModel) -> m (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ do
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        result <- propagateGError $ gtk_file_dialog_select_multiple_folders_finish self' result_'
        maybeResult <- convertIfNonNull result $ \Ptr ListModel
result' -> do
            result'' <- ((ManagedPtr ListModel -> ListModel)
-> Ptr ListModel -> IO ListModel
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ListModel -> ListModel
Gio.ListModel.ListModel) Ptr ListModel
result'
            return result''
        touchManagedPtr self
        touchManagedPtr result_
        return maybeResult
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDialogSelectMultipleFoldersFinishMethodInfo
instance (signature ~ (b -> m (Maybe Gio.ListModel.ListModel)), MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDialogSelectMultipleFoldersFinishMethodInfo a signature where
    overloadedMethod = fileDialogSelectMultipleFoldersFinish

instance O.OverloadedMethodInfo FileDialogSelectMultipleFoldersFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSelectMultipleFoldersFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSelectMultipleFoldersFinish"
        })


#endif

-- method FileDialog::set_accept_label
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accept_label"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new accept label"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_accept_label" gtk_file_dialog_set_accept_label :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    CString ->                              -- accept_label : TBasicType TUTF8
    IO ()

-- | Sets the label shown on the file chooser\'s accept button.
-- 
-- Leaving the accept label unset or setting it as @NULL@ will
-- fall back to a default label, depending on what API is used
-- to launch the file dialog.
-- 
-- /Since: 4.10/
fileDialogSetAcceptLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (T.Text)
    -- ^ /@acceptLabel@/: the new accept label
    -> m ()
fileDialogSetAcceptLabel :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> Maybe Text -> m ()
fileDialogSetAcceptLabel a
self Maybe Text
acceptLabel = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeAcceptLabel <- case acceptLabel of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jAcceptLabel -> do
            jAcceptLabel' <- Text -> IO CString
textToCString Text
jAcceptLabel
            return jAcceptLabel'
    gtk_file_dialog_set_accept_label self' maybeAcceptLabel
    touchManagedPtr self
    freeMem maybeAcceptLabel
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetAcceptLabelMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogSetAcceptLabelMethodInfo a signature where
    overloadedMethod = fileDialogSetAcceptLabel

instance O.OverloadedMethodInfo FileDialogSetAcceptLabelMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetAcceptLabel",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetAcceptLabel"
        })


#endif

-- method FileDialog::set_default_filter
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the file filter" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_default_filter" gtk_file_dialog_set_default_filter :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gtk.FileFilter.FileFilter ->        -- filter : TInterface (Name {namespace = "Gtk", name = "FileFilter"})
    IO ()

-- | Sets the filter that will be selected by default
-- in the file chooser dialog.
-- 
-- If set to @NULL@, the first item in [FileDialog:filters]("GI.Gtk.Objects.FileDialog#g:attr:filters")
-- will be used as the default filter. If that list is empty, the dialog
-- will be unfiltered.
-- 
-- /Since: 4.10/
fileDialogSetDefaultFilter ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gtk.FileFilter.IsFileFilter b) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@filter@/: the file filter
    -> m ()
fileDialogSetDefaultFilter :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsFileFilter b) =>
a -> Maybe b -> m ()
fileDialogSetDefaultFilter a
self Maybe b
filter = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeFilter <- case filter of
        Maybe b
Nothing -> Ptr FileFilter -> IO (Ptr FileFilter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FileFilter
forall a. Ptr a
FP.nullPtr
        Just b
jFilter -> do
            jFilter' <- b -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFilter
            return jFilter'
    gtk_file_dialog_set_default_filter self' maybeFilter
    touchManagedPtr self
    whenJust filter touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetDefaultFilterMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFileDialog a, Gtk.FileFilter.IsFileFilter b) => O.OverloadedMethod FileDialogSetDefaultFilterMethodInfo a signature where
    overloadedMethod = fileDialogSetDefaultFilter

instance O.OverloadedMethodInfo FileDialogSetDefaultFilterMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetDefaultFilter",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetDefaultFilter"
        })


#endif

-- method FileDialog::set_filters
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filters"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a list model of [class@Gtk.FileFilter]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_filters" gtk_file_dialog_set_filters :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.ListModel.ListModel ->          -- filters : TInterface (Name {namespace = "Gio", name = "ListModel"})
    IO ()

-- | Sets the filters that will be offered to the user
-- in the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogSetFilters ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.ListModel.IsListModel b) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@filters@/: a list model of t'GI.Gtk.Objects.FileFilter.FileFilter'
    -> m ()
fileDialogSetFilters :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsListModel b) =>
a -> Maybe b -> m ()
fileDialogSetFilters a
self Maybe b
filters = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeFilters <- case filters of
        Maybe b
Nothing -> Ptr ListModel -> IO (Ptr ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ListModel
forall a. Ptr a
FP.nullPtr
        Just b
jFilters -> do
            jFilters' <- b -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFilters
            return jFilters'
    gtk_file_dialog_set_filters self' maybeFilters
    touchManagedPtr self
    whenJust filters touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetFiltersMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFileDialog a, Gio.ListModel.IsListModel b) => O.OverloadedMethod FileDialogSetFiltersMethodInfo a signature where
    overloadedMethod = fileDialogSetFilters

instance O.OverloadedMethodInfo FileDialogSetFiltersMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetFilters",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetFilters"
        })


#endif

-- method FileDialog::set_initial_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_initial_file" gtk_file_dialog_set_initial_file :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | Sets the file that will be initially selected in
-- the file chooser dialog.
-- 
-- This function is a shortcut for calling both
-- 'GI.Gtk.Objects.FileDialog.fileDialogSetInitialFolder' and
-- 'GI.Gtk.Objects.FileDialog.fileDialogSetInitialName' with the
-- directory and name of /@file@/, respectively.
-- 
-- /Since: 4.10/
fileDialogSetInitialFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.File.IsFile b) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@file@/: a file
    -> m ()
fileDialogSetInitialFile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsFile b) =>
a -> Maybe b -> m ()
fileDialogSetInitialFile a
self Maybe b
file = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeFile <- case file of
        Maybe b
Nothing -> Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
FP.nullPtr
        Just b
jFile -> do
            jFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFile
            return jFile'
    gtk_file_dialog_set_initial_file self' maybeFile
    touchManagedPtr self
    whenJust file touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetInitialFileMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFileDialog a, Gio.File.IsFile b) => O.OverloadedMethod FileDialogSetInitialFileMethodInfo a signature where
    overloadedMethod = fileDialogSetInitialFile

instance O.OverloadedMethodInfo FileDialogSetInitialFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetInitialFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetInitialFile"
        })


#endif

-- method FileDialog::set_initial_folder
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "folder"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_initial_folder" gtk_file_dialog_set_initial_folder :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    Ptr Gio.File.File ->                    -- folder : TInterface (Name {namespace = "Gio", name = "File"})
    IO ()

-- | Sets the folder that will be set as the
-- initial folder in the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogSetInitialFolder ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.File.IsFile b) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (b)
    -- ^ /@folder@/: a file
    -> m ()
fileDialogSetInitialFolder :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsFile b) =>
a -> Maybe b -> m ()
fileDialogSetInitialFolder a
self Maybe b
folder = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeFolder <- case folder of
        Maybe b
Nothing -> Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
FP.nullPtr
        Just b
jFolder -> do
            jFolder' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFolder
            return jFolder'
    gtk_file_dialog_set_initial_folder self' maybeFolder
    touchManagedPtr self
    whenJust folder touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetInitialFolderMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFileDialog a, Gio.File.IsFile b) => O.OverloadedMethod FileDialogSetInitialFolderMethodInfo a signature where
    overloadedMethod = fileDialogSetInitialFolder

instance O.OverloadedMethodInfo FileDialogSetInitialFolderMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetInitialFolder",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetInitialFolder"
        })


#endif

-- method FileDialog::set_initial_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_initial_name" gtk_file_dialog_set_initial_name :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    CString ->                              -- name : TBasicType TUTF8
    IO ()

-- | Sets the filename that will be initially selected.
-- 
-- For save dialogs, /@name@/ will usually be pre-entered into the
-- name field.
-- 
-- If a file with this name already exists in the directory set
-- via [FileDialog:initialFolder]("GI.Gtk.Objects.FileDialog#g:attr:initialFolder"), the dialog will
-- preselect it.
-- 
-- /Since: 4.10/
fileDialogSetInitialName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> Maybe (T.Text)
    -- ^ /@name@/: a string
    -> m ()
fileDialogSetInitialName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> Maybe Text -> m ()
fileDialogSetInitialName a
self Maybe Text
name = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    maybeName <- case name of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
FP.nullPtr
        Just Text
jName -> do
            jName' <- Text -> IO CString
textToCString Text
jName
            return jName'
    gtk_file_dialog_set_initial_name self' maybeName
    touchManagedPtr self
    freeMem maybeName
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetInitialNameMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogSetInitialNameMethodInfo a signature where
    overloadedMethod = fileDialogSetInitialName

instance O.OverloadedMethodInfo FileDialogSetInitialNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetInitialName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetInitialName"
        })


#endif

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

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

-- | Sets whether the file chooser dialog blocks interaction
-- with the parent window while it is presented.
-- 
-- /Since: 4.10/
fileDialogSetModal ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> Bool
    -- ^ /@modal@/: the new value
    -> m ()
fileDialogSetModal :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> Bool -> m ()
fileDialogSetModal 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let 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
    gtk_file_dialog_set_modal self' modal'
    touchManagedPtr self
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetModalMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogSetModalMethodInfo a signature where
    overloadedMethod = fileDialogSetModal

instance O.OverloadedMethodInfo FileDialogSetModalMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetModal",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetModal"
        })


#endif

-- method FileDialog::set_title
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileDialog" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file dialog" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_file_dialog_set_title" gtk_file_dialog_set_title :: 
    Ptr FileDialog ->                       -- self : TInterface (Name {namespace = "Gtk", name = "FileDialog"})
    CString ->                              -- title : TBasicType TUTF8
    IO ()

-- | Sets the title that will be shown on the file chooser dialog.
-- 
-- /Since: 4.10/
fileDialogSetTitle ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a file dialog
    -> T.Text
    -- ^ /@title@/: the new title
    -> m ()
fileDialogSetTitle :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFileDialog a) =>
a -> Text -> m ()
fileDialogSetTitle a
self Text
title = 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
    self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    title' <- textToCString title
    gtk_file_dialog_set_title self' title'
    touchManagedPtr self
    freeMem title'
    return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetTitleMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsFileDialog a) => O.OverloadedMethod FileDialogSetTitleMethodInfo a signature where
    overloadedMethod = fileDialogSetTitle

instance O.OverloadedMethodInfo FileDialogSetTitleMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.fileDialogSetTitle",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk4-4.0.12/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetTitle"
        })


#endif