{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GtkFileDialog@ object collects the arguments that
-- are needed to present a file chooser 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. These APIs follow the
-- GIO async pattern, and the result can be obtained by calling
-- the corresponding finish function, for example
-- 'GI.Gtk.Objects.FileDialog.fileDialogOpenFinish'.
-- 
-- /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"), [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"), [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            ,


-- ** save #method:save#

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


-- ** saveFinish #method:saveFinish#

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


-- ** 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, that is, the filter that is initially
-- active in the file chooser dialog.
-- 
-- If the default filter is 'P.Nothing', 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 'P.Nothing', 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 those two properties interact.
-- 
-- /Since: 4.10/

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


-- ** initialFile #attr:initialFile#
-- | The inital file, that is, the file that 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 inital folder, that 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 inital name, that is, the filename 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 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

-- | 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 `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 `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 'FileDialog' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe 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 FileDialog
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 FileDialog
ptr Ptr FileDialog -> Ptr FileDialog -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr FileDialog
forall a. Ptr a
FP.nullPtr
        then FileDialog -> Maybe FileDialog
forall a. a -> Maybe a
P.Just (FileDialog -> Maybe FileDialog)
-> IO FileDialog -> IO (Maybe FileDialog)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr FileDialog -> FileDialog)
-> Ptr FileDialog -> IO FileDialog
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr FileDialog -> FileDialog
FileDialog Ptr FileDialog
ptr
        else Maybe FileDialog -> IO (Maybe FileDialog)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileDialog
forall a. Maybe a
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 "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 "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 `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-gtk-4.0.8/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 `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-gtk-4.0.8/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 False)

-- | 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 `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)

#if defined(ENABLE_OVERLOADING)
data FileDialogFiltersPropertyInfo
instance AttrInfo FileDialogFiltersPropertyInfo where
    type AttrAllowedOps FileDialogFiltersPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    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 = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Objects.FileDialog.filters"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/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 `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-gtk-4.0.8/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 `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-gtk-4.0.8/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 `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-gtk-4.0.8/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 `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-gtk-4.0.8/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 `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-gtk-4.0.8/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
    Ptr FileDialog
result <- IO (Ptr FileDialog)
gtk_file_dialog_new
    Text -> Ptr FileDialog -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileDialogNew" Ptr FileDialog
result
    FileDialog
result' <- ((ManagedPtr FileDialog -> FileDialog)
-> Ptr FileDialog -> IO FileDialog
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileDialog -> FileDialog
FileDialog) Ptr FileDialog
result
    FileDialog -> IO FileDialog
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileDialog
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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

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

-- | /No description available in the introspection data./
-- 
-- /Since: 4.10/
fileDialogGetAcceptLabel ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr FileDialog -> IO CString
gtk_file_dialog_get_accept_label Ptr FileDialog
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> m (Maybe Gtk.FileFilter.FileFilter)
    -- ^ __Returns:__ the current 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr FileFilter
result <- Ptr FileDialog -> IO (Ptr FileFilter)
gtk_file_dialog_get_default_filter Ptr FileDialog
self'
    Maybe FileFilter
maybeResult <- Ptr FileFilter
-> (Ptr FileFilter -> IO FileFilter) -> IO (Maybe FileFilter)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FileFilter
result ((Ptr FileFilter -> IO FileFilter) -> IO (Maybe FileFilter))
-> (Ptr FileFilter -> IO FileFilter) -> IO (Maybe FileFilter)
forall a b. (a -> b) -> a -> b
$ \Ptr FileFilter
result' -> do
        FileFilter
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'
        FileFilter -> IO FileFilter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FileFilter
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe FileFilter -> IO (Maybe FileFilter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FileFilter
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ the filters, as
    --   a @GListModel@ of @GtkFileFilters@
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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
result <- Ptr FileDialog -> IO (Ptr ListModel)
gtk_file_dialog_get_filters Ptr FileDialog
self'
    Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
        ListModel
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'
        ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr FileDialog -> IO (Ptr File)
gtk_file_dialog_get_initial_file Ptr FileDialog
self'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        File
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'
        File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr FileDialog -> IO (Ptr File)
gtk_file_dialog_get_initial_folder Ptr FileDialog
self'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        File
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'
        File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

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

-- | Gets the name for the file that should be initially set.
-- 
-- /Since: 4.10/
fileDialogGetInitialName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr FileDialog -> IO CString
gtk_file_dialog_get_initial_name Ptr FileDialog
self'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr FileDialog -> IO CInt
gtk_file_dialog_get_modal Ptr FileDialog
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr FileDialog -> IO CString
gtk_file_dialog_get_title Ptr FileDialog
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileDialogGetTitle" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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
--           , 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 operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 ()

-- | This function initiates a file selection operation by
-- presenting a file chooser dialog to the user.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- It should call 'GI.Gtk.Objects.FileDialog.fileDialogOpenFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fileDialogOpen ::
    (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 ()
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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
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
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileDialog
-> Ptr Window
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_file_dialog_open Ptr FileDialog
self' Ptr Window
maybeParent Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 and
-- returns the resulting file.
-- 
-- /Since: 4.10/
fileDialogOpenFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the file that was selected.
    --   Otherwise, @NULL@ is returned and /@error@/ is set /(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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe File) -> IO () -> IO (Maybe File)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr File
result <- (Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File))
-> (Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File)
forall a b. (a -> b) -> a -> b
$ Ptr FileDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr File)
gtk_file_dialog_open_finish Ptr FileDialog
self' Ptr AsyncResult
result_'
        Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
            File
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'
            File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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
--           , 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 operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 ()

-- | This function initiates a multi-file selection operation by
-- presenting a file chooser dialog to the user.
-- 
-- The file chooser 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.
-- It should call 'GI.Gtk.Objects.FileDialog.fileDialogOpenMultipleFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fileDialogOpenMultiple ::
    (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 ()
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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
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
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileDialog
-> Ptr Window
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_file_dialog_open_multiple Ptr FileDialog
self' Ptr Window
maybeParent Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 and
-- returns the resulting files in a @GListModel@.
-- 
-- /Since: 4.10/
fileDialogOpenMultipleFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ the file that was selected,
    --   as a @GListModel@ of @GFiles@. Otherwise, @NULL@ is returned
    --   and /@error@/ is set /(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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe ListModel) -> IO () -> IO (Maybe ListModel)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ListModel
result <- (Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel))
-> (Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel)
forall a b. (a -> b) -> a -> b
$ Ptr FileDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ListModel)
gtk_file_dialog_open_multiple_finish Ptr FileDialog
self' Ptr AsyncResult
result_'
        Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
            ListModel
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'
            ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogOpenMultipleFinish"
        })


#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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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
--           , 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 operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 ()

-- | This function initiates a file save operation by
-- presenting a file chooser dialog to the user.
-- 
-- The /@callback@/ will be called when the dialog is dismissed.
-- It should call 'GI.Gtk.Objects.FileDialog.fileDialogSaveFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fileDialogSave ::
    (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 ()
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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
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
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileDialog
-> Ptr Window
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_file_dialog_save Ptr FileDialog
self' Ptr Window
maybeParent Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 and
-- returns the resulting file.
-- 
-- /Since: 4.10/
fileDialogSaveFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the file that was selected.
    --   Otherwise, @NULL@ is returned and /@error@/ is set /(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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe File) -> IO () -> IO (Maybe File)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr File
result <- (Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File))
-> (Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File)
forall a b. (a -> b) -> a -> b
$ Ptr FileDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr File)
gtk_file_dialog_save_finish Ptr FileDialog
self' Ptr AsyncResult
result_'
        Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
            File
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'
            File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSaveFinish"
        })


#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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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
--           , 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 operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 ()

-- | This function initiates a directory selection operation by
-- presenting a file chooser dialog to the user.
-- 
-- If you pass /@initialFolder@/, the file chooser 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.
-- It should call 'GI.Gtk.Objects.FileDialog.fileDialogSelectFolderFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fileDialogSelectFolder ::
    (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 ()
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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
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
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileDialog
-> Ptr Window
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_file_dialog_select_folder Ptr FileDialog
self' Ptr Window
maybeParent Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 and
-- returns the resulting file.
-- 
-- /Since: 4.10/
fileDialogSelectFolderFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the file that was selected.
    --   Otherwise, @NULL@ is returned and /@error@/ is set /(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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe File) -> IO () -> IO (Maybe File)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr File
result <- (Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File))
-> (Ptr (Ptr GError) -> IO (Ptr File)) -> IO (Ptr File)
forall a b. (a -> b) -> a -> b
$ Ptr FileDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr File)
gtk_file_dialog_select_folder_finish Ptr FileDialog
self' Ptr AsyncResult
result_'
        Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
            File
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'
            File -> IO File
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe File -> IO (Maybe File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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
--           , 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 operation is complete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 ()

-- | This function initiates a multi-directory selection operation by
-- presenting a file chooser dialog to the user.
-- 
-- The file chooser 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.
-- It should call 'GI.Gtk.Objects.FileDialog.fileDialogSelectMultipleFoldersFinish'
-- to obtain the result.
-- 
-- /Since: 4.10/
fileDialogSelectMultipleFolders ::
    (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 ()
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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Window
maybeParent <- case Maybe b
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
nullPtr
        Just b
jParent -> do
            Ptr Window
jParent' <- b -> IO (Ptr Window)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr Window -> IO (Ptr Window)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Window
jParent'
    Ptr Cancellable
maybeCancellable <- case Maybe c
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
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) AsyncReadyCallback
jCallback)
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr FileDialog
-> Ptr Window
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
gtk_file_dialog_select_multiple_folders Ptr FileDialog
self' Ptr Window
maybeParent Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
parent b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 and returns the resulting files in a @GListModel@.
-- 
-- /Since: 4.10/
fileDialogSelectMultipleFoldersFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> b
    -- ^ /@result@/: a @GAsyncResult@
    -> m (Maybe Gio.ListModel.ListModel)
    -- ^ __Returns:__ the file that was selected,
    --   as a @GListModel@ of @GFiles@. Otherwise, @NULL@ is returned
    --   and /@error@/ is set /(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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO (Maybe ListModel) -> IO () -> IO (Maybe ListModel)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ListModel
result <- (Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel))
-> (Ptr (Ptr GError) -> IO (Ptr ListModel)) -> IO (Ptr ListModel)
forall a b. (a -> b) -> a -> b
$ Ptr FileDialog
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr ListModel)
gtk_file_dialog_select_multiple_folders_finish Ptr FileDialog
self' Ptr AsyncResult
result_'
        Maybe ListModel
maybeResult <- Ptr ListModel
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ListModel
result ((Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel))
-> (Ptr ListModel -> IO ListModel) -> IO (Maybe ListModel)
forall a b. (a -> b) -> a -> b
$ \Ptr ListModel
result' -> do
            ListModel
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'
            ListModel -> IO ListModel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListModel
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Maybe ListModel -> IO (Maybe ListModel)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ListModel
maybeResult
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeAcceptLabel <- case Maybe Text
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
nullPtr
        Just Text
jAcceptLabel -> do
            CString
jAcceptLabel' <- Text -> IO CString
textToCString Text
jAcceptLabel
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jAcceptLabel'
    Ptr FileDialog -> CString -> IO ()
gtk_file_dialog_set_accept_label Ptr FileDialog
self' CString
maybeAcceptLabel
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeAcceptLabel
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filter"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileFilter" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkFileFilter`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 'P.Nothing', 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 @GtkFileDialog@
    -> Maybe (b)
    -- ^ /@filter@/: a @GtkFileFilter@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr FileFilter
maybeFilter <- case Maybe b
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
nullPtr
        Just b
jFilter -> do
            Ptr FileFilter
jFilter' <- b -> IO (Ptr FileFilter)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFilter
            Ptr FileFilter -> IO (Ptr FileFilter)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr FileFilter
jFilter'
    Ptr FileDialog -> Ptr FileFilter -> IO ()
gtk_file_dialog_set_default_filter Ptr FileDialog
self' Ptr FileFilter
maybeFilter
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
filter b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filters"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ListModel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GListModel` of `GtkFileFilters`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> b
    -- ^ /@filters@/: a @GListModel@ of @GtkFileFilters@
    -> m ()
fileDialogSetFilters :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFileDialog a, IsListModel b) =>
a -> b -> m ()
fileDialogSetFilters a
self 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr ListModel
filters' <- b -> IO (Ptr ListModel)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
filters
    Ptr FileDialog -> Ptr ListModel -> IO ()
gtk_file_dialog_set_filters Ptr FileDialog
self' Ptr ListModel
filters'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
filters
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileDialogSetFiltersMethodInfo
instance (signature ~ (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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GFile`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> Maybe (b)
    -- ^ /@file@/: a @GFile@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
maybeFile <- case Maybe b
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
nullPtr
        Just b
jFile -> do
            Ptr File
jFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFile
            Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jFile'
    Ptr FileDialog -> Ptr File -> IO ()
gtk_file_dialog_set_initial_file Ptr FileDialog
self' Ptr File
maybeFile
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
file b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "folder"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GFile`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 @GtkFileDialog@
    -> Maybe (b)
    -- ^ /@folder@/: a @GFile@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
maybeFolder <- case Maybe b
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
nullPtr
        Just b
jFolder -> do
            Ptr File
jFolder' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jFolder
            Ptr File -> IO (Ptr File)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jFolder'
    Ptr FileDialog -> Ptr File -> IO ()
gtk_file_dialog_set_initial_folder Ptr FileDialog
self' Ptr File
maybeFolder
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
folder b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a UTF8 string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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 name for the file that should be initially set.
-- For saving dialogs, this 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 should preselect it.
-- 
-- /Since: 4.10/
fileDialogSetInitialName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFileDialog a) =>
    a
    -- ^ /@self@/: a @GtkFileDialog@
    -> Maybe (T.Text)
    -- ^ /@name@/: a UTF8 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeName <- case Maybe Text
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
nullPtr
        Just Text
jName -> do
            CString
jName' <- Text -> IO CString
textToCString Text
jName
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jName'
    Ptr FileDialog -> CString -> IO ()
gtk_file_dialog_set_initial_name Ptr FileDialog
self' CString
maybeName
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeName
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modal"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let modal' :: CInt
modal' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
P.fromEnum) Bool
modal
    Ptr FileDialog -> CInt -> IO ()
gtk_file_dialog_set_modal Ptr FileDialog
self' CInt
modal'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data 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-gtk-4.0.8/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 `GtkFileDialog`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = 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
--           , 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 @GtkFileDialog@
    -> 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
    Ptr FileDialog
self' <- a -> IO (Ptr FileDialog)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr FileDialog -> CString -> IO ()
gtk_file_dialog_set_title Ptr FileDialog
self' CString
title'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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-gtk-4.0.8/docs/GI-Gtk-Objects-FileDialog.html#v:fileDialogSetTitle"
        })


#endif