{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Interfaces.File.File' is a high level abstraction for manipulating files on a
-- virtual file system. @/GFiles/@ are lightweight, immutable objects
-- that do no I\/O upon creation. It is necessary to understand that
-- t'GI.Gio.Interfaces.File.File' objects do not represent files, merely an identifier for a
-- file. All file content I\/O is implemented as streaming operations
-- (see t'GI.Gio.Objects.InputStream.InputStream' and t'GI.Gio.Objects.OutputStream.OutputStream').
-- 
-- To construct a t'GI.Gio.Interfaces.File.File', you can use:
-- 
-- * 'GI.Gio.Functions.fileNewForPath' if you have a path.
-- * 'GI.Gio.Functions.fileNewForUri' if you have a URI.
-- * 'GI.Gio.Functions.fileNewForCommandlineArg' for a command line argument.
-- * 'GI.Gio.Functions.fileNewTmp' to create a temporary file from a template.
-- * 'GI.Gio.Functions.fileParseName' from a UTF-8 string gotten from 'GI.Gio.Interfaces.File.fileGetParseName'.
-- * @/g_file_new_build_filename()/@ to create a file from path elements.
-- 
-- 
-- One way to think of a t'GI.Gio.Interfaces.File.File' is as an abstraction of a pathname. For
-- normal files the system pathname is what is stored internally, but as
-- @/GFiles/@ are extensible it could also be something else that corresponds
-- to a pathname in a userspace implementation of a filesystem.
-- 
-- @/GFiles/@ make up hierarchies of directories and files that correspond to
-- the files on a filesystem. You can move through the file system with
-- t'GI.Gio.Interfaces.File.File' using 'GI.Gio.Interfaces.File.fileGetParent' to get an identifier for the parent
-- directory, 'GI.Gio.Interfaces.File.fileGetChild' to get a child within a directory,
-- 'GI.Gio.Interfaces.File.fileResolveRelativePath' to resolve a relative path between two
-- @/GFiles/@. There can be multiple hierarchies, so you may not end up at
-- the same root if you repeatedly call 'GI.Gio.Interfaces.File.fileGetParent' on two different
-- files.
-- 
-- All @/GFiles/@ have a basename (get with 'GI.Gio.Interfaces.File.fileGetBasename'). These names
-- are byte strings that are used to identify the file on the filesystem
-- (relative to its parent directory) and there is no guarantees that they
-- have any particular charset encoding or even make any sense at all. If
-- you want to use filenames in a user interface you should use the display
-- name that you can get by requesting the
-- 'GI.Gio.Constants.FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME' attribute with 'GI.Gio.Interfaces.File.fileQueryInfo'.
-- This is guaranteed to be in UTF-8 and can be used in a user interface.
-- But always store the real basename or the t'GI.Gio.Interfaces.File.File' to use to actually
-- access the file, because there is no way to go from a display name to
-- the actual name.
-- 
-- Using t'GI.Gio.Interfaces.File.File' as an identifier has the same weaknesses as using a path
-- in that there may be multiple aliases for the same file. For instance,
-- hard or soft links may cause two different @/GFiles/@ to refer to the same
-- file. Other possible causes for aliases are: case insensitive filesystems,
-- short and long names on FAT\/NTFS, or bind mounts in Linux. If you want to
-- check if two @/GFiles/@ point to the same file you can query for the
-- 'GI.Gio.Constants.FILE_ATTRIBUTE_ID_FILE' attribute. Note that t'GI.Gio.Interfaces.File.File' does some trivial
-- canonicalization of pathnames passed in, so that trivial differences in
-- the path string used at creation (duplicated slashes, slash at end of
-- path, \".\" or \"..\" path segments, etc) does not create different @/GFiles/@.
-- 
-- Many t'GI.Gio.Interfaces.File.File' operations have both synchronous and asynchronous versions
-- to suit your application. Asynchronous versions of synchronous functions
-- simply have @/_async()/@ appended to their function names. The asynchronous
-- I\/O functions call a t'GI.Gio.Callbacks.AsyncReadyCallback' which is then used to finalize
-- the operation, producing a GAsyncResult which is then passed to the
-- function\'s matching @/_finish()/@ operation.
-- 
-- It is highly recommended to use asynchronous calls when running within a
-- shared main loop, such as in the main thread of an application. This avoids
-- I\/O operations blocking other sources on the main loop from being dispatched.
-- Synchronous I\/O operations should be performed from worker threads. See the
-- [introduction to asynchronous programming section][async-programming] for
-- more.
-- 
-- Some t'GI.Gio.Interfaces.File.File' operations almost always take a noticeable amount of time, and
-- so do not have synchronous analogs. Notable cases include:
-- 
-- * 'GI.Gio.Interfaces.File.fileMountMountable' to mount a mountable file.
-- * 'GI.Gio.Interfaces.File.fileUnmountMountableWithOperation' to unmount a mountable file.
-- * 'GI.Gio.Interfaces.File.fileEjectMountableWithOperation' to eject a mountable file.
-- 
-- 
-- ## Entity Tags # {@/gfile/@-etag}
-- 
-- One notable feature of @/GFiles/@ are entity tags, or \"etags\" for
-- short. Entity tags are somewhat like a more abstract version of the
-- traditional mtime, and can be used to quickly determine if the file
-- has been modified from the version on the file system. See the
-- HTTP 1.1
-- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html specification>
-- for HTTP Etag headers, which are a very similar concept.

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

module GI.Gio.Interfaces.File
    ( 
#if defined(ENABLE_OVERLOADING)
    FileCopyAsyncMethodInfo                 ,
#endif

-- * Exported types
    File(..)                                ,
    IsFile                                  ,
    toFile                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendTo]("GI.Gio.Interfaces.File#g:method:appendTo"), [appendToAsync]("GI.Gio.Interfaces.File#g:method:appendToAsync"), [appendToFinish]("GI.Gio.Interfaces.File#g:method:appendToFinish"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [copy]("GI.Gio.Interfaces.File#g:method:copy"), [copyAsync]("GI.Gio.Interfaces.File#g:method:copyAsync"), [copyAttributes]("GI.Gio.Interfaces.File#g:method:copyAttributes"), [copyFinish]("GI.Gio.Interfaces.File#g:method:copyFinish"), [create]("GI.Gio.Interfaces.File#g:method:create"), [createAsync]("GI.Gio.Interfaces.File#g:method:createAsync"), [createFinish]("GI.Gio.Interfaces.File#g:method:createFinish"), [createReadwrite]("GI.Gio.Interfaces.File#g:method:createReadwrite"), [createReadwriteAsync]("GI.Gio.Interfaces.File#g:method:createReadwriteAsync"), [createReadwriteFinish]("GI.Gio.Interfaces.File#g:method:createReadwriteFinish"), [delete]("GI.Gio.Interfaces.File#g:method:delete"), [deleteAsync]("GI.Gio.Interfaces.File#g:method:deleteAsync"), [deleteFinish]("GI.Gio.Interfaces.File#g:method:deleteFinish"), [dup]("GI.Gio.Interfaces.File#g:method:dup"), [ejectMountable]("GI.Gio.Interfaces.File#g:method:ejectMountable"), [ejectMountableFinish]("GI.Gio.Interfaces.File#g:method:ejectMountableFinish"), [ejectMountableWithOperation]("GI.Gio.Interfaces.File#g:method:ejectMountableWithOperation"), [ejectMountableWithOperationFinish]("GI.Gio.Interfaces.File#g:method:ejectMountableWithOperationFinish"), [enumerateChildren]("GI.Gio.Interfaces.File#g:method:enumerateChildren"), [enumerateChildrenAsync]("GI.Gio.Interfaces.File#g:method:enumerateChildrenAsync"), [enumerateChildrenFinish]("GI.Gio.Interfaces.File#g:method:enumerateChildrenFinish"), [equal]("GI.Gio.Interfaces.File#g:method:equal"), [findEnclosingMount]("GI.Gio.Interfaces.File#g:method:findEnclosingMount"), [findEnclosingMountAsync]("GI.Gio.Interfaces.File#g:method:findEnclosingMountAsync"), [findEnclosingMountFinish]("GI.Gio.Interfaces.File#g:method:findEnclosingMountFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasParent]("GI.Gio.Interfaces.File#g:method:hasParent"), [hasPrefix]("GI.Gio.Interfaces.File#g:method:hasPrefix"), [hasUriScheme]("GI.Gio.Interfaces.File#g:method:hasUriScheme"), [hash]("GI.Gio.Interfaces.File#g:method:hash"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isNative]("GI.Gio.Interfaces.File#g:method:isNative"), [loadBytes]("GI.Gio.Interfaces.File#g:method:loadBytes"), [loadBytesAsync]("GI.Gio.Interfaces.File#g:method:loadBytesAsync"), [loadBytesFinish]("GI.Gio.Interfaces.File#g:method:loadBytesFinish"), [loadContents]("GI.Gio.Interfaces.File#g:method:loadContents"), [loadContentsAsync]("GI.Gio.Interfaces.File#g:method:loadContentsAsync"), [loadContentsFinish]("GI.Gio.Interfaces.File#g:method:loadContentsFinish"), [loadPartialContentsFinish]("GI.Gio.Interfaces.File#g:method:loadPartialContentsFinish"), [makeDirectory]("GI.Gio.Interfaces.File#g:method:makeDirectory"), [makeDirectoryAsync]("GI.Gio.Interfaces.File#g:method:makeDirectoryAsync"), [makeDirectoryFinish]("GI.Gio.Interfaces.File#g:method:makeDirectoryFinish"), [makeDirectoryWithParents]("GI.Gio.Interfaces.File#g:method:makeDirectoryWithParents"), [makeSymbolicLink]("GI.Gio.Interfaces.File#g:method:makeSymbolicLink"), [measureDiskUsageFinish]("GI.Gio.Interfaces.File#g:method:measureDiskUsageFinish"), [monitor]("GI.Gio.Interfaces.File#g:method:monitor"), [monitorDirectory]("GI.Gio.Interfaces.File#g:method:monitorDirectory"), [monitorFile]("GI.Gio.Interfaces.File#g:method:monitorFile"), [mountEnclosingVolume]("GI.Gio.Interfaces.File#g:method:mountEnclosingVolume"), [mountEnclosingVolumeFinish]("GI.Gio.Interfaces.File#g:method:mountEnclosingVolumeFinish"), [mountMountable]("GI.Gio.Interfaces.File#g:method:mountMountable"), [mountMountableFinish]("GI.Gio.Interfaces.File#g:method:mountMountableFinish"), [move]("GI.Gio.Interfaces.File#g:method:move"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [openReadwrite]("GI.Gio.Interfaces.File#g:method:openReadwrite"), [openReadwriteAsync]("GI.Gio.Interfaces.File#g:method:openReadwriteAsync"), [openReadwriteFinish]("GI.Gio.Interfaces.File#g:method:openReadwriteFinish"), [peekPath]("GI.Gio.Interfaces.File#g:method:peekPath"), [pollMountable]("GI.Gio.Interfaces.File#g:method:pollMountable"), [pollMountableFinish]("GI.Gio.Interfaces.File#g:method:pollMountableFinish"), [queryDefaultHandler]("GI.Gio.Interfaces.File#g:method:queryDefaultHandler"), [queryDefaultHandlerAsync]("GI.Gio.Interfaces.File#g:method:queryDefaultHandlerAsync"), [queryDefaultHandlerFinish]("GI.Gio.Interfaces.File#g:method:queryDefaultHandlerFinish"), [queryExists]("GI.Gio.Interfaces.File#g:method:queryExists"), [queryFileType]("GI.Gio.Interfaces.File#g:method:queryFileType"), [queryFilesystemInfo]("GI.Gio.Interfaces.File#g:method:queryFilesystemInfo"), [queryFilesystemInfoAsync]("GI.Gio.Interfaces.File#g:method:queryFilesystemInfoAsync"), [queryFilesystemInfoFinish]("GI.Gio.Interfaces.File#g:method:queryFilesystemInfoFinish"), [queryInfo]("GI.Gio.Interfaces.File#g:method:queryInfo"), [queryInfoAsync]("GI.Gio.Interfaces.File#g:method:queryInfoAsync"), [queryInfoFinish]("GI.Gio.Interfaces.File#g:method:queryInfoFinish"), [querySettableAttributes]("GI.Gio.Interfaces.File#g:method:querySettableAttributes"), [queryWritableNamespaces]("GI.Gio.Interfaces.File#g:method:queryWritableNamespaces"), [read]("GI.Gio.Interfaces.File#g:method:read"), [readAsync]("GI.Gio.Interfaces.File#g:method:readAsync"), [readFinish]("GI.Gio.Interfaces.File#g:method:readFinish"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [replace]("GI.Gio.Interfaces.File#g:method:replace"), [replaceAsync]("GI.Gio.Interfaces.File#g:method:replaceAsync"), [replaceContents]("GI.Gio.Interfaces.File#g:method:replaceContents"), [replaceContentsAsync]("GI.Gio.Interfaces.File#g:method:replaceContentsAsync"), [replaceContentsBytesAsync]("GI.Gio.Interfaces.File#g:method:replaceContentsBytesAsync"), [replaceContentsFinish]("GI.Gio.Interfaces.File#g:method:replaceContentsFinish"), [replaceFinish]("GI.Gio.Interfaces.File#g:method:replaceFinish"), [replaceReadwrite]("GI.Gio.Interfaces.File#g:method:replaceReadwrite"), [replaceReadwriteAsync]("GI.Gio.Interfaces.File#g:method:replaceReadwriteAsync"), [replaceReadwriteFinish]("GI.Gio.Interfaces.File#g:method:replaceReadwriteFinish"), [resolveRelativePath]("GI.Gio.Interfaces.File#g:method:resolveRelativePath"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [startMountable]("GI.Gio.Interfaces.File#g:method:startMountable"), [startMountableFinish]("GI.Gio.Interfaces.File#g:method:startMountableFinish"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [stopMountable]("GI.Gio.Interfaces.File#g:method:stopMountable"), [stopMountableFinish]("GI.Gio.Interfaces.File#g:method:stopMountableFinish"), [supportsThreadContexts]("GI.Gio.Interfaces.File#g:method:supportsThreadContexts"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [trash]("GI.Gio.Interfaces.File#g:method:trash"), [trashAsync]("GI.Gio.Interfaces.File#g:method:trashAsync"), [trashFinish]("GI.Gio.Interfaces.File#g:method:trashFinish"), [unmountMountable]("GI.Gio.Interfaces.File#g:method:unmountMountable"), [unmountMountableFinish]("GI.Gio.Interfaces.File#g:method:unmountMountableFinish"), [unmountMountableWithOperation]("GI.Gio.Interfaces.File#g:method:unmountMountableWithOperation"), [unmountMountableWithOperationFinish]("GI.Gio.Interfaces.File#g:method:unmountMountableWithOperationFinish"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getBasename]("GI.Gio.Interfaces.File#g:method:getBasename"), [getChild]("GI.Gio.Interfaces.File#g:method:getChild"), [getChildForDisplayName]("GI.Gio.Interfaces.File#g:method:getChildForDisplayName"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getParent]("GI.Gio.Interfaces.File#g:method:getParent"), [getParseName]("GI.Gio.Interfaces.File#g:method:getParseName"), [getPath]("GI.Gio.Interfaces.File#g:method:getPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRelativePath]("GI.Gio.Interfaces.File#g:method:getRelativePath"), [getUri]("GI.Gio.Interfaces.File#g:method:getUri"), [getUriScheme]("GI.Gio.Interfaces.File#g:method:getUriScheme").
-- 
-- ==== Setters
-- [setAttribute]("GI.Gio.Interfaces.File#g:method:setAttribute"), [setAttributeByteString]("GI.Gio.Interfaces.File#g:method:setAttributeByteString"), [setAttributeInt32]("GI.Gio.Interfaces.File#g:method:setAttributeInt32"), [setAttributeInt64]("GI.Gio.Interfaces.File#g:method:setAttributeInt64"), [setAttributeString]("GI.Gio.Interfaces.File#g:method:setAttributeString"), [setAttributeUint32]("GI.Gio.Interfaces.File#g:method:setAttributeUint32"), [setAttributeUint64]("GI.Gio.Interfaces.File#g:method:setAttributeUint64"), [setAttributesAsync]("GI.Gio.Interfaces.File#g:method:setAttributesAsync"), [setAttributesFinish]("GI.Gio.Interfaces.File#g:method:setAttributesFinish"), [setAttributesFromInfo]("GI.Gio.Interfaces.File#g:method:setAttributesFromInfo"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDisplayName]("GI.Gio.Interfaces.File#g:method:setDisplayName"), [setDisplayNameAsync]("GI.Gio.Interfaces.File#g:method:setDisplayNameAsync"), [setDisplayNameFinish]("GI.Gio.Interfaces.File#g:method:setDisplayNameFinish"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveFileMethod                       ,
#endif

-- ** appendTo #method:appendTo#

#if defined(ENABLE_OVERLOADING)
    FileAppendToMethodInfo                  ,
#endif
    fileAppendTo                            ,


-- ** appendToAsync #method:appendToAsync#

#if defined(ENABLE_OVERLOADING)
    FileAppendToAsyncMethodInfo             ,
#endif
    fileAppendToAsync                       ,


-- ** appendToFinish #method:appendToFinish#

#if defined(ENABLE_OVERLOADING)
    FileAppendToFinishMethodInfo            ,
#endif
    fileAppendToFinish                      ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    FileCopyMethodInfo                      ,
#endif
    fileCopy                                ,


-- ** copyAttributes #method:copyAttributes#

#if defined(ENABLE_OVERLOADING)
    FileCopyAttributesMethodInfo            ,
#endif
    fileCopyAttributes                      ,


-- ** copyFinish #method:copyFinish#

#if defined(ENABLE_OVERLOADING)
    FileCopyFinishMethodInfo                ,
#endif
    fileCopyFinish                          ,


-- ** create #method:create#

#if defined(ENABLE_OVERLOADING)
    FileCreateMethodInfo                    ,
#endif
    fileCreate                              ,


-- ** createAsync #method:createAsync#

#if defined(ENABLE_OVERLOADING)
    FileCreateAsyncMethodInfo               ,
#endif
    fileCreateAsync                         ,


-- ** createFinish #method:createFinish#

#if defined(ENABLE_OVERLOADING)
    FileCreateFinishMethodInfo              ,
#endif
    fileCreateFinish                        ,


-- ** createReadwrite #method:createReadwrite#

#if defined(ENABLE_OVERLOADING)
    FileCreateReadwriteMethodInfo           ,
#endif
    fileCreateReadwrite                     ,


-- ** createReadwriteAsync #method:createReadwriteAsync#

#if defined(ENABLE_OVERLOADING)
    FileCreateReadwriteAsyncMethodInfo      ,
#endif
    fileCreateReadwriteAsync                ,


-- ** createReadwriteFinish #method:createReadwriteFinish#

#if defined(ENABLE_OVERLOADING)
    FileCreateReadwriteFinishMethodInfo     ,
#endif
    fileCreateReadwriteFinish               ,


-- ** delete #method:delete#

#if defined(ENABLE_OVERLOADING)
    FileDeleteMethodInfo                    ,
#endif
    fileDelete                              ,


-- ** deleteAsync #method:deleteAsync#

#if defined(ENABLE_OVERLOADING)
    FileDeleteAsyncMethodInfo               ,
#endif
    fileDeleteAsync                         ,


-- ** deleteFinish #method:deleteFinish#

#if defined(ENABLE_OVERLOADING)
    FileDeleteFinishMethodInfo              ,
#endif
    fileDeleteFinish                        ,


-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    FileDupMethodInfo                       ,
#endif
    fileDup                                 ,


-- ** ejectMountable #method:ejectMountable#

#if defined(ENABLE_OVERLOADING)
    FileEjectMountableMethodInfo            ,
#endif
    fileEjectMountable                      ,


-- ** ejectMountableFinish #method:ejectMountableFinish#

#if defined(ENABLE_OVERLOADING)
    FileEjectMountableFinishMethodInfo      ,
#endif
    fileEjectMountableFinish                ,


-- ** ejectMountableWithOperation #method:ejectMountableWithOperation#

#if defined(ENABLE_OVERLOADING)
    FileEjectMountableWithOperationMethodInfo,
#endif
    fileEjectMountableWithOperation         ,


-- ** ejectMountableWithOperationFinish #method:ejectMountableWithOperationFinish#

#if defined(ENABLE_OVERLOADING)
    FileEjectMountableWithOperationFinishMethodInfo,
#endif
    fileEjectMountableWithOperationFinish   ,


-- ** enumerateChildren #method:enumerateChildren#

#if defined(ENABLE_OVERLOADING)
    FileEnumerateChildrenMethodInfo         ,
#endif
    fileEnumerateChildren                   ,


-- ** enumerateChildrenAsync #method:enumerateChildrenAsync#

#if defined(ENABLE_OVERLOADING)
    FileEnumerateChildrenAsyncMethodInfo    ,
#endif
    fileEnumerateChildrenAsync              ,


-- ** enumerateChildrenFinish #method:enumerateChildrenFinish#

#if defined(ENABLE_OVERLOADING)
    FileEnumerateChildrenFinishMethodInfo   ,
#endif
    fileEnumerateChildrenFinish             ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    FileEqualMethodInfo                     ,
#endif
    fileEqual                               ,


-- ** findEnclosingMount #method:findEnclosingMount#

#if defined(ENABLE_OVERLOADING)
    FileFindEnclosingMountMethodInfo        ,
#endif
    fileFindEnclosingMount                  ,


-- ** findEnclosingMountAsync #method:findEnclosingMountAsync#

#if defined(ENABLE_OVERLOADING)
    FileFindEnclosingMountAsyncMethodInfo   ,
#endif
    fileFindEnclosingMountAsync             ,


-- ** findEnclosingMountFinish #method:findEnclosingMountFinish#

#if defined(ENABLE_OVERLOADING)
    FileFindEnclosingMountFinishMethodInfo  ,
#endif
    fileFindEnclosingMountFinish            ,


-- ** getBasename #method:getBasename#

#if defined(ENABLE_OVERLOADING)
    FileGetBasenameMethodInfo               ,
#endif
    fileGetBasename                         ,


-- ** getChild #method:getChild#

#if defined(ENABLE_OVERLOADING)
    FileGetChildMethodInfo                  ,
#endif
    fileGetChild                            ,


-- ** getChildForDisplayName #method:getChildForDisplayName#

#if defined(ENABLE_OVERLOADING)
    FileGetChildForDisplayNameMethodInfo    ,
#endif
    fileGetChildForDisplayName              ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    FileGetParentMethodInfo                 ,
#endif
    fileGetParent                           ,


-- ** getParseName #method:getParseName#

#if defined(ENABLE_OVERLOADING)
    FileGetParseNameMethodInfo              ,
#endif
    fileGetParseName                        ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    FileGetPathMethodInfo                   ,
#endif
    fileGetPath                             ,


-- ** getRelativePath #method:getRelativePath#

#if defined(ENABLE_OVERLOADING)
    FileGetRelativePathMethodInfo           ,
#endif
    fileGetRelativePath                     ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    FileGetUriMethodInfo                    ,
#endif
    fileGetUri                              ,


-- ** getUriScheme #method:getUriScheme#

#if defined(ENABLE_OVERLOADING)
    FileGetUriSchemeMethodInfo              ,
#endif
    fileGetUriScheme                        ,


-- ** hasParent #method:hasParent#

#if defined(ENABLE_OVERLOADING)
    FileHasParentMethodInfo                 ,
#endif
    fileHasParent                           ,


-- ** hasPrefix #method:hasPrefix#

#if defined(ENABLE_OVERLOADING)
    FileHasPrefixMethodInfo                 ,
#endif
    fileHasPrefix                           ,


-- ** hasUriScheme #method:hasUriScheme#

#if defined(ENABLE_OVERLOADING)
    FileHasUriSchemeMethodInfo              ,
#endif
    fileHasUriScheme                        ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    FileHashMethodInfo                      ,
#endif
    fileHash                                ,


-- ** isNative #method:isNative#

#if defined(ENABLE_OVERLOADING)
    FileIsNativeMethodInfo                  ,
#endif
    fileIsNative                            ,


-- ** loadBytes #method:loadBytes#

#if defined(ENABLE_OVERLOADING)
    FileLoadBytesMethodInfo                 ,
#endif
    fileLoadBytes                           ,


-- ** loadBytesAsync #method:loadBytesAsync#

#if defined(ENABLE_OVERLOADING)
    FileLoadBytesAsyncMethodInfo            ,
#endif
    fileLoadBytesAsync                      ,


-- ** loadBytesFinish #method:loadBytesFinish#

#if defined(ENABLE_OVERLOADING)
    FileLoadBytesFinishMethodInfo           ,
#endif
    fileLoadBytesFinish                     ,


-- ** loadContents #method:loadContents#

#if defined(ENABLE_OVERLOADING)
    FileLoadContentsMethodInfo              ,
#endif
    fileLoadContents                        ,


-- ** loadContentsAsync #method:loadContentsAsync#

#if defined(ENABLE_OVERLOADING)
    FileLoadContentsAsyncMethodInfo         ,
#endif
    fileLoadContentsAsync                   ,


-- ** loadContentsFinish #method:loadContentsFinish#

#if defined(ENABLE_OVERLOADING)
    FileLoadContentsFinishMethodInfo        ,
#endif
    fileLoadContentsFinish                  ,


-- ** loadPartialContentsFinish #method:loadPartialContentsFinish#

#if defined(ENABLE_OVERLOADING)
    FileLoadPartialContentsFinishMethodInfo ,
#endif
    fileLoadPartialContentsFinish           ,


-- ** makeDirectory #method:makeDirectory#

#if defined(ENABLE_OVERLOADING)
    FileMakeDirectoryMethodInfo             ,
#endif
    fileMakeDirectory                       ,


-- ** makeDirectoryAsync #method:makeDirectoryAsync#

#if defined(ENABLE_OVERLOADING)
    FileMakeDirectoryAsyncMethodInfo        ,
#endif
    fileMakeDirectoryAsync                  ,


-- ** makeDirectoryFinish #method:makeDirectoryFinish#

#if defined(ENABLE_OVERLOADING)
    FileMakeDirectoryFinishMethodInfo       ,
#endif
    fileMakeDirectoryFinish                 ,


-- ** makeDirectoryWithParents #method:makeDirectoryWithParents#

#if defined(ENABLE_OVERLOADING)
    FileMakeDirectoryWithParentsMethodInfo  ,
#endif
    fileMakeDirectoryWithParents            ,


-- ** makeSymbolicLink #method:makeSymbolicLink#

#if defined(ENABLE_OVERLOADING)
    FileMakeSymbolicLinkMethodInfo          ,
#endif
    fileMakeSymbolicLink                    ,


-- ** measureDiskUsageFinish #method:measureDiskUsageFinish#

#if defined(ENABLE_OVERLOADING)
    FileMeasureDiskUsageFinishMethodInfo    ,
#endif
    fileMeasureDiskUsageFinish              ,


-- ** monitor #method:monitor#

#if defined(ENABLE_OVERLOADING)
    FileMonitorMethodInfo                   ,
#endif
    fileMonitor                             ,


-- ** monitorDirectory #method:monitorDirectory#

#if defined(ENABLE_OVERLOADING)
    FileMonitorDirectoryMethodInfo          ,
#endif
    fileMonitorDirectory                    ,


-- ** monitorFile #method:monitorFile#

#if defined(ENABLE_OVERLOADING)
    FileMonitorFileMethodInfo               ,
#endif
    fileMonitorFile                         ,


-- ** mountEnclosingVolume #method:mountEnclosingVolume#

#if defined(ENABLE_OVERLOADING)
    FileMountEnclosingVolumeMethodInfo      ,
#endif
    fileMountEnclosingVolume                ,


-- ** mountEnclosingVolumeFinish #method:mountEnclosingVolumeFinish#

#if defined(ENABLE_OVERLOADING)
    FileMountEnclosingVolumeFinishMethodInfo,
#endif
    fileMountEnclosingVolumeFinish          ,


-- ** mountMountable #method:mountMountable#

#if defined(ENABLE_OVERLOADING)
    FileMountMountableMethodInfo            ,
#endif
    fileMountMountable                      ,


-- ** mountMountableFinish #method:mountMountableFinish#

#if defined(ENABLE_OVERLOADING)
    FileMountMountableFinishMethodInfo      ,
#endif
    fileMountMountableFinish                ,


-- ** move #method:move#

#if defined(ENABLE_OVERLOADING)
    FileMoveMethodInfo                      ,
#endif
    fileMove                                ,


-- ** newForCommandlineArg #method:newForCommandlineArg#

    fileNewForCommandlineArg                ,


-- ** newForCommandlineArgAndCwd #method:newForCommandlineArgAndCwd#

    fileNewForCommandlineArgAndCwd          ,


-- ** newForPath #method:newForPath#

    fileNewForPath                          ,


-- ** newForUri #method:newForUri#

    fileNewForUri                           ,


-- ** newTmp #method:newTmp#

    fileNewTmp                              ,


-- ** openReadwrite #method:openReadwrite#

#if defined(ENABLE_OVERLOADING)
    FileOpenReadwriteMethodInfo             ,
#endif
    fileOpenReadwrite                       ,


-- ** openReadwriteAsync #method:openReadwriteAsync#

#if defined(ENABLE_OVERLOADING)
    FileOpenReadwriteAsyncMethodInfo        ,
#endif
    fileOpenReadwriteAsync                  ,


-- ** openReadwriteFinish #method:openReadwriteFinish#

#if defined(ENABLE_OVERLOADING)
    FileOpenReadwriteFinishMethodInfo       ,
#endif
    fileOpenReadwriteFinish                 ,


-- ** parseName #method:parseName#

    fileParseName                           ,


-- ** peekPath #method:peekPath#

#if defined(ENABLE_OVERLOADING)
    FilePeekPathMethodInfo                  ,
#endif
    filePeekPath                            ,


-- ** pollMountable #method:pollMountable#

#if defined(ENABLE_OVERLOADING)
    FilePollMountableMethodInfo             ,
#endif
    filePollMountable                       ,


-- ** pollMountableFinish #method:pollMountableFinish#

#if defined(ENABLE_OVERLOADING)
    FilePollMountableFinishMethodInfo       ,
#endif
    filePollMountableFinish                 ,


-- ** queryDefaultHandler #method:queryDefaultHandler#

#if defined(ENABLE_OVERLOADING)
    FileQueryDefaultHandlerMethodInfo       ,
#endif
    fileQueryDefaultHandler                 ,


-- ** queryDefaultHandlerAsync #method:queryDefaultHandlerAsync#

#if defined(ENABLE_OVERLOADING)
    FileQueryDefaultHandlerAsyncMethodInfo  ,
#endif
    fileQueryDefaultHandlerAsync            ,


-- ** queryDefaultHandlerFinish #method:queryDefaultHandlerFinish#

#if defined(ENABLE_OVERLOADING)
    FileQueryDefaultHandlerFinishMethodInfo ,
#endif
    fileQueryDefaultHandlerFinish           ,


-- ** queryExists #method:queryExists#

#if defined(ENABLE_OVERLOADING)
    FileQueryExistsMethodInfo               ,
#endif
    fileQueryExists                         ,


-- ** queryFileType #method:queryFileType#

#if defined(ENABLE_OVERLOADING)
    FileQueryFileTypeMethodInfo             ,
#endif
    fileQueryFileType                       ,


-- ** queryFilesystemInfo #method:queryFilesystemInfo#

#if defined(ENABLE_OVERLOADING)
    FileQueryFilesystemInfoMethodInfo       ,
#endif
    fileQueryFilesystemInfo                 ,


-- ** queryFilesystemInfoAsync #method:queryFilesystemInfoAsync#

#if defined(ENABLE_OVERLOADING)
    FileQueryFilesystemInfoAsyncMethodInfo  ,
#endif
    fileQueryFilesystemInfoAsync            ,


-- ** queryFilesystemInfoFinish #method:queryFilesystemInfoFinish#

#if defined(ENABLE_OVERLOADING)
    FileQueryFilesystemInfoFinishMethodInfo ,
#endif
    fileQueryFilesystemInfoFinish           ,


-- ** queryInfo #method:queryInfo#

#if defined(ENABLE_OVERLOADING)
    FileQueryInfoMethodInfo                 ,
#endif
    fileQueryInfo                           ,


-- ** queryInfoAsync #method:queryInfoAsync#

#if defined(ENABLE_OVERLOADING)
    FileQueryInfoAsyncMethodInfo            ,
#endif
    fileQueryInfoAsync                      ,


-- ** queryInfoFinish #method:queryInfoFinish#

#if defined(ENABLE_OVERLOADING)
    FileQueryInfoFinishMethodInfo           ,
#endif
    fileQueryInfoFinish                     ,


-- ** querySettableAttributes #method:querySettableAttributes#

#if defined(ENABLE_OVERLOADING)
    FileQuerySettableAttributesMethodInfo   ,
#endif
    fileQuerySettableAttributes             ,


-- ** queryWritableNamespaces #method:queryWritableNamespaces#

#if defined(ENABLE_OVERLOADING)
    FileQueryWritableNamespacesMethodInfo   ,
#endif
    fileQueryWritableNamespaces             ,


-- ** read #method:read#

#if defined(ENABLE_OVERLOADING)
    FileReadMethodInfo                      ,
#endif
    fileRead                                ,


-- ** readAsync #method:readAsync#

#if defined(ENABLE_OVERLOADING)
    FileReadAsyncMethodInfo                 ,
#endif
    fileReadAsync                           ,


-- ** readFinish #method:readFinish#

#if defined(ENABLE_OVERLOADING)
    FileReadFinishMethodInfo                ,
#endif
    fileReadFinish                          ,


-- ** replace #method:replace#

#if defined(ENABLE_OVERLOADING)
    FileReplaceMethodInfo                   ,
#endif
    fileReplace                             ,


-- ** replaceAsync #method:replaceAsync#

#if defined(ENABLE_OVERLOADING)
    FileReplaceAsyncMethodInfo              ,
#endif
    fileReplaceAsync                        ,


-- ** replaceContents #method:replaceContents#

#if defined(ENABLE_OVERLOADING)
    FileReplaceContentsMethodInfo           ,
#endif
    fileReplaceContents                     ,


-- ** replaceContentsAsync #method:replaceContentsAsync#

#if defined(ENABLE_OVERLOADING)
    FileReplaceContentsAsyncMethodInfo      ,
#endif
    fileReplaceContentsAsync                ,


-- ** replaceContentsBytesAsync #method:replaceContentsBytesAsync#

#if defined(ENABLE_OVERLOADING)
    FileReplaceContentsBytesAsyncMethodInfo ,
#endif
    fileReplaceContentsBytesAsync           ,


-- ** replaceContentsFinish #method:replaceContentsFinish#

#if defined(ENABLE_OVERLOADING)
    FileReplaceContentsFinishMethodInfo     ,
#endif
    fileReplaceContentsFinish               ,


-- ** replaceFinish #method:replaceFinish#

#if defined(ENABLE_OVERLOADING)
    FileReplaceFinishMethodInfo             ,
#endif
    fileReplaceFinish                       ,


-- ** replaceReadwrite #method:replaceReadwrite#

#if defined(ENABLE_OVERLOADING)
    FileReplaceReadwriteMethodInfo          ,
#endif
    fileReplaceReadwrite                    ,


-- ** replaceReadwriteAsync #method:replaceReadwriteAsync#

#if defined(ENABLE_OVERLOADING)
    FileReplaceReadwriteAsyncMethodInfo     ,
#endif
    fileReplaceReadwriteAsync               ,


-- ** replaceReadwriteFinish #method:replaceReadwriteFinish#

#if defined(ENABLE_OVERLOADING)
    FileReplaceReadwriteFinishMethodInfo    ,
#endif
    fileReplaceReadwriteFinish              ,


-- ** resolveRelativePath #method:resolveRelativePath#

#if defined(ENABLE_OVERLOADING)
    FileResolveRelativePathMethodInfo       ,
#endif
    fileResolveRelativePath                 ,


-- ** setAttribute #method:setAttribute#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeMethodInfo              ,
#endif
    fileSetAttribute                        ,


-- ** setAttributeByteString #method:setAttributeByteString#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeByteStringMethodInfo    ,
#endif
    fileSetAttributeByteString              ,


-- ** setAttributeInt32 #method:setAttributeInt32#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeInt32MethodInfo         ,
#endif
    fileSetAttributeInt32                   ,


-- ** setAttributeInt64 #method:setAttributeInt64#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeInt64MethodInfo         ,
#endif
    fileSetAttributeInt64                   ,


-- ** setAttributeString #method:setAttributeString#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeStringMethodInfo        ,
#endif
    fileSetAttributeString                  ,


-- ** setAttributeUint32 #method:setAttributeUint32#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeUint32MethodInfo        ,
#endif
    fileSetAttributeUint32                  ,


-- ** setAttributeUint64 #method:setAttributeUint64#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributeUint64MethodInfo        ,
#endif
    fileSetAttributeUint64                  ,


-- ** setAttributesAsync #method:setAttributesAsync#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributesAsyncMethodInfo        ,
#endif
    fileSetAttributesAsync                  ,


-- ** setAttributesFinish #method:setAttributesFinish#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributesFinishMethodInfo       ,
#endif
    fileSetAttributesFinish                 ,


-- ** setAttributesFromInfo #method:setAttributesFromInfo#

#if defined(ENABLE_OVERLOADING)
    FileSetAttributesFromInfoMethodInfo     ,
#endif
    fileSetAttributesFromInfo               ,


-- ** setDisplayName #method:setDisplayName#

#if defined(ENABLE_OVERLOADING)
    FileSetDisplayNameMethodInfo            ,
#endif
    fileSetDisplayName                      ,


-- ** setDisplayNameAsync #method:setDisplayNameAsync#

#if defined(ENABLE_OVERLOADING)
    FileSetDisplayNameAsyncMethodInfo       ,
#endif
    fileSetDisplayNameAsync                 ,


-- ** setDisplayNameFinish #method:setDisplayNameFinish#

#if defined(ENABLE_OVERLOADING)
    FileSetDisplayNameFinishMethodInfo      ,
#endif
    fileSetDisplayNameFinish                ,


-- ** startMountable #method:startMountable#

#if defined(ENABLE_OVERLOADING)
    FileStartMountableMethodInfo            ,
#endif
    fileStartMountable                      ,


-- ** startMountableFinish #method:startMountableFinish#

#if defined(ENABLE_OVERLOADING)
    FileStartMountableFinishMethodInfo      ,
#endif
    fileStartMountableFinish                ,


-- ** stopMountable #method:stopMountable#

#if defined(ENABLE_OVERLOADING)
    FileStopMountableMethodInfo             ,
#endif
    fileStopMountable                       ,


-- ** stopMountableFinish #method:stopMountableFinish#

#if defined(ENABLE_OVERLOADING)
    FileStopMountableFinishMethodInfo       ,
#endif
    fileStopMountableFinish                 ,


-- ** supportsThreadContexts #method:supportsThreadContexts#

#if defined(ENABLE_OVERLOADING)
    FileSupportsThreadContextsMethodInfo    ,
#endif
    fileSupportsThreadContexts              ,


-- ** trash #method:trash#

#if defined(ENABLE_OVERLOADING)
    FileTrashMethodInfo                     ,
#endif
    fileTrash                               ,


-- ** trashAsync #method:trashAsync#

#if defined(ENABLE_OVERLOADING)
    FileTrashAsyncMethodInfo                ,
#endif
    fileTrashAsync                          ,


-- ** trashFinish #method:trashFinish#

#if defined(ENABLE_OVERLOADING)
    FileTrashFinishMethodInfo               ,
#endif
    fileTrashFinish                         ,


-- ** unmountMountable #method:unmountMountable#

#if defined(ENABLE_OVERLOADING)
    FileUnmountMountableMethodInfo          ,
#endif
    fileUnmountMountable                    ,


-- ** unmountMountableFinish #method:unmountMountableFinish#

#if defined(ENABLE_OVERLOADING)
    FileUnmountMountableFinishMethodInfo    ,
#endif
    fileUnmountMountableFinish              ,


-- ** unmountMountableWithOperation #method:unmountMountableWithOperation#

#if defined(ENABLE_OVERLOADING)
    FileUnmountMountableWithOperationMethodInfo,
#endif
    fileUnmountMountableWithOperation       ,


-- ** unmountMountableWithOperationFinish #method:unmountMountableWithOperationFinish#

#if defined(ENABLE_OVERLOADING)
    FileUnmountMountableWithOperationFinishMethodInfo,
#endif
    fileUnmountMountableWithOperationFinish ,




    ) 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.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Structs.Bytes as GLib.Bytes
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Enums as Gio.Enums
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AppInfo as Gio.AppInfo
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Mount as Gio.Mount
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.FileEnumerator as Gio.FileEnumerator
import {-# SOURCE #-} qualified GI.Gio.Objects.FileIOStream as Gio.FileIOStream
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInfo as Gio.FileInfo
import {-# SOURCE #-} qualified GI.Gio.Objects.FileInputStream as Gio.FileInputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.FileMonitor as Gio.FileMonitor
import {-# SOURCE #-} qualified GI.Gio.Objects.FileOutputStream as Gio.FileOutputStream
import {-# SOURCE #-} qualified GI.Gio.Objects.MountOperation as Gio.MountOperation
import {-# SOURCE #-} qualified GI.Gio.Structs.FileAttributeInfoList as Gio.FileAttributeInfoList

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

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

foreign import ccall "g_file_get_type"
    c_g_file_get_type :: IO B.Types.GType

instance B.Types.TypedObject File where
    glibType :: IO GType
glibType = IO GType
c_g_file_get_type

instance B.Types.GObject File

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList File
type instance O.AttributeList File = FileAttributeList
type FileAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveFileMethod (t :: Symbol) (o :: *) :: * where
    ResolveFileMethod "appendTo" o = FileAppendToMethodInfo
    ResolveFileMethod "appendToAsync" o = FileAppendToAsyncMethodInfo
    ResolveFileMethod "appendToFinish" o = FileAppendToFinishMethodInfo
    ResolveFileMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveFileMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveFileMethod "copy" o = FileCopyMethodInfo
    ResolveFileMethod "copyAsync" o = FileCopyAsyncMethodInfo
    ResolveFileMethod "copyAttributes" o = FileCopyAttributesMethodInfo
    ResolveFileMethod "copyFinish" o = FileCopyFinishMethodInfo
    ResolveFileMethod "create" o = FileCreateMethodInfo
    ResolveFileMethod "createAsync" o = FileCreateAsyncMethodInfo
    ResolveFileMethod "createFinish" o = FileCreateFinishMethodInfo
    ResolveFileMethod "createReadwrite" o = FileCreateReadwriteMethodInfo
    ResolveFileMethod "createReadwriteAsync" o = FileCreateReadwriteAsyncMethodInfo
    ResolveFileMethod "createReadwriteFinish" o = FileCreateReadwriteFinishMethodInfo
    ResolveFileMethod "delete" o = FileDeleteMethodInfo
    ResolveFileMethod "deleteAsync" o = FileDeleteAsyncMethodInfo
    ResolveFileMethod "deleteFinish" o = FileDeleteFinishMethodInfo
    ResolveFileMethod "dup" o = FileDupMethodInfo
    ResolveFileMethod "ejectMountable" o = FileEjectMountableMethodInfo
    ResolveFileMethod "ejectMountableFinish" o = FileEjectMountableFinishMethodInfo
    ResolveFileMethod "ejectMountableWithOperation" o = FileEjectMountableWithOperationMethodInfo
    ResolveFileMethod "ejectMountableWithOperationFinish" o = FileEjectMountableWithOperationFinishMethodInfo
    ResolveFileMethod "enumerateChildren" o = FileEnumerateChildrenMethodInfo
    ResolveFileMethod "enumerateChildrenAsync" o = FileEnumerateChildrenAsyncMethodInfo
    ResolveFileMethod "enumerateChildrenFinish" o = FileEnumerateChildrenFinishMethodInfo
    ResolveFileMethod "equal" o = FileEqualMethodInfo
    ResolveFileMethod "findEnclosingMount" o = FileFindEnclosingMountMethodInfo
    ResolveFileMethod "findEnclosingMountAsync" o = FileFindEnclosingMountAsyncMethodInfo
    ResolveFileMethod "findEnclosingMountFinish" o = FileFindEnclosingMountFinishMethodInfo
    ResolveFileMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveFileMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveFileMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveFileMethod "hasParent" o = FileHasParentMethodInfo
    ResolveFileMethod "hasPrefix" o = FileHasPrefixMethodInfo
    ResolveFileMethod "hasUriScheme" o = FileHasUriSchemeMethodInfo
    ResolveFileMethod "hash" o = FileHashMethodInfo
    ResolveFileMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveFileMethod "isNative" o = FileIsNativeMethodInfo
    ResolveFileMethod "loadBytes" o = FileLoadBytesMethodInfo
    ResolveFileMethod "loadBytesAsync" o = FileLoadBytesAsyncMethodInfo
    ResolveFileMethod "loadBytesFinish" o = FileLoadBytesFinishMethodInfo
    ResolveFileMethod "loadContents" o = FileLoadContentsMethodInfo
    ResolveFileMethod "loadContentsAsync" o = FileLoadContentsAsyncMethodInfo
    ResolveFileMethod "loadContentsFinish" o = FileLoadContentsFinishMethodInfo
    ResolveFileMethod "loadPartialContentsFinish" o = FileLoadPartialContentsFinishMethodInfo
    ResolveFileMethod "makeDirectory" o = FileMakeDirectoryMethodInfo
    ResolveFileMethod "makeDirectoryAsync" o = FileMakeDirectoryAsyncMethodInfo
    ResolveFileMethod "makeDirectoryFinish" o = FileMakeDirectoryFinishMethodInfo
    ResolveFileMethod "makeDirectoryWithParents" o = FileMakeDirectoryWithParentsMethodInfo
    ResolveFileMethod "makeSymbolicLink" o = FileMakeSymbolicLinkMethodInfo
    ResolveFileMethod "measureDiskUsageFinish" o = FileMeasureDiskUsageFinishMethodInfo
    ResolveFileMethod "monitor" o = FileMonitorMethodInfo
    ResolveFileMethod "monitorDirectory" o = FileMonitorDirectoryMethodInfo
    ResolveFileMethod "monitorFile" o = FileMonitorFileMethodInfo
    ResolveFileMethod "mountEnclosingVolume" o = FileMountEnclosingVolumeMethodInfo
    ResolveFileMethod "mountEnclosingVolumeFinish" o = FileMountEnclosingVolumeFinishMethodInfo
    ResolveFileMethod "mountMountable" o = FileMountMountableMethodInfo
    ResolveFileMethod "mountMountableFinish" o = FileMountMountableFinishMethodInfo
    ResolveFileMethod "move" o = FileMoveMethodInfo
    ResolveFileMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveFileMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveFileMethod "openReadwrite" o = FileOpenReadwriteMethodInfo
    ResolveFileMethod "openReadwriteAsync" o = FileOpenReadwriteAsyncMethodInfo
    ResolveFileMethod "openReadwriteFinish" o = FileOpenReadwriteFinishMethodInfo
    ResolveFileMethod "peekPath" o = FilePeekPathMethodInfo
    ResolveFileMethod "pollMountable" o = FilePollMountableMethodInfo
    ResolveFileMethod "pollMountableFinish" o = FilePollMountableFinishMethodInfo
    ResolveFileMethod "queryDefaultHandler" o = FileQueryDefaultHandlerMethodInfo
    ResolveFileMethod "queryDefaultHandlerAsync" o = FileQueryDefaultHandlerAsyncMethodInfo
    ResolveFileMethod "queryDefaultHandlerFinish" o = FileQueryDefaultHandlerFinishMethodInfo
    ResolveFileMethod "queryExists" o = FileQueryExistsMethodInfo
    ResolveFileMethod "queryFileType" o = FileQueryFileTypeMethodInfo
    ResolveFileMethod "queryFilesystemInfo" o = FileQueryFilesystemInfoMethodInfo
    ResolveFileMethod "queryFilesystemInfoAsync" o = FileQueryFilesystemInfoAsyncMethodInfo
    ResolveFileMethod "queryFilesystemInfoFinish" o = FileQueryFilesystemInfoFinishMethodInfo
    ResolveFileMethod "queryInfo" o = FileQueryInfoMethodInfo
    ResolveFileMethod "queryInfoAsync" o = FileQueryInfoAsyncMethodInfo
    ResolveFileMethod "queryInfoFinish" o = FileQueryInfoFinishMethodInfo
    ResolveFileMethod "querySettableAttributes" o = FileQuerySettableAttributesMethodInfo
    ResolveFileMethod "queryWritableNamespaces" o = FileQueryWritableNamespacesMethodInfo
    ResolveFileMethod "read" o = FileReadMethodInfo
    ResolveFileMethod "readAsync" o = FileReadAsyncMethodInfo
    ResolveFileMethod "readFinish" o = FileReadFinishMethodInfo
    ResolveFileMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveFileMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveFileMethod "replace" o = FileReplaceMethodInfo
    ResolveFileMethod "replaceAsync" o = FileReplaceAsyncMethodInfo
    ResolveFileMethod "replaceContents" o = FileReplaceContentsMethodInfo
    ResolveFileMethod "replaceContentsAsync" o = FileReplaceContentsAsyncMethodInfo
    ResolveFileMethod "replaceContentsBytesAsync" o = FileReplaceContentsBytesAsyncMethodInfo
    ResolveFileMethod "replaceContentsFinish" o = FileReplaceContentsFinishMethodInfo
    ResolveFileMethod "replaceFinish" o = FileReplaceFinishMethodInfo
    ResolveFileMethod "replaceReadwrite" o = FileReplaceReadwriteMethodInfo
    ResolveFileMethod "replaceReadwriteAsync" o = FileReplaceReadwriteAsyncMethodInfo
    ResolveFileMethod "replaceReadwriteFinish" o = FileReplaceReadwriteFinishMethodInfo
    ResolveFileMethod "resolveRelativePath" o = FileResolveRelativePathMethodInfo
    ResolveFileMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveFileMethod "startMountable" o = FileStartMountableMethodInfo
    ResolveFileMethod "startMountableFinish" o = FileStartMountableFinishMethodInfo
    ResolveFileMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveFileMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveFileMethod "stopMountable" o = FileStopMountableMethodInfo
    ResolveFileMethod "stopMountableFinish" o = FileStopMountableFinishMethodInfo
    ResolveFileMethod "supportsThreadContexts" o = FileSupportsThreadContextsMethodInfo
    ResolveFileMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveFileMethod "trash" o = FileTrashMethodInfo
    ResolveFileMethod "trashAsync" o = FileTrashAsyncMethodInfo
    ResolveFileMethod "trashFinish" o = FileTrashFinishMethodInfo
    ResolveFileMethod "unmountMountable" o = FileUnmountMountableMethodInfo
    ResolveFileMethod "unmountMountableFinish" o = FileUnmountMountableFinishMethodInfo
    ResolveFileMethod "unmountMountableWithOperation" o = FileUnmountMountableWithOperationMethodInfo
    ResolveFileMethod "unmountMountableWithOperationFinish" o = FileUnmountMountableWithOperationFinishMethodInfo
    ResolveFileMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveFileMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveFileMethod "getBasename" o = FileGetBasenameMethodInfo
    ResolveFileMethod "getChild" o = FileGetChildMethodInfo
    ResolveFileMethod "getChildForDisplayName" o = FileGetChildForDisplayNameMethodInfo
    ResolveFileMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveFileMethod "getParent" o = FileGetParentMethodInfo
    ResolveFileMethod "getParseName" o = FileGetParseNameMethodInfo
    ResolveFileMethod "getPath" o = FileGetPathMethodInfo
    ResolveFileMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveFileMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveFileMethod "getRelativePath" o = FileGetRelativePathMethodInfo
    ResolveFileMethod "getUri" o = FileGetUriMethodInfo
    ResolveFileMethod "getUriScheme" o = FileGetUriSchemeMethodInfo
    ResolveFileMethod "setAttribute" o = FileSetAttributeMethodInfo
    ResolveFileMethod "setAttributeByteString" o = FileSetAttributeByteStringMethodInfo
    ResolveFileMethod "setAttributeInt32" o = FileSetAttributeInt32MethodInfo
    ResolveFileMethod "setAttributeInt64" o = FileSetAttributeInt64MethodInfo
    ResolveFileMethod "setAttributeString" o = FileSetAttributeStringMethodInfo
    ResolveFileMethod "setAttributeUint32" o = FileSetAttributeUint32MethodInfo
    ResolveFileMethod "setAttributeUint64" o = FileSetAttributeUint64MethodInfo
    ResolveFileMethod "setAttributesAsync" o = FileSetAttributesAsyncMethodInfo
    ResolveFileMethod "setAttributesFinish" o = FileSetAttributesFinishMethodInfo
    ResolveFileMethod "setAttributesFromInfo" o = FileSetAttributesFromInfoMethodInfo
    ResolveFileMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveFileMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveFileMethod "setDisplayName" o = FileSetDisplayNameMethodInfo
    ResolveFileMethod "setDisplayNameAsync" o = FileSetDisplayNameAsyncMethodInfo
    ResolveFileMethod "setDisplayNameFinish" o = FileSetDisplayNameFinishMethodInfo
    ResolveFileMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveFileMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method File::append_to
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileOutputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_append_to" g_file_append_to :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileOutputStream.FileOutputStream)

-- | Gets an output stream for appending data to the file.
-- If the file doesn\'t already exist it is created.
-- 
-- By default files created are generally readable by everyone,
-- but if you pass @/G_FILE_CREATE_PRIVATE/@ in /@flags@/ the file
-- will be made readable only to the current user, to the level that
-- is supported on the target filesystem.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- Some file systems don\'t allow all file names, and may return an
-- 'GI.Gio.Enums.IOErrorEnumInvalidFilename' error. If the file is a directory the
-- 'GI.Gio.Enums.IOErrorEnumIsDirectory' error will be returned. Other errors are
-- possible too, and depend on what kind of filesystem the file is on.
fileAppendTo ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileOutputStream.FileOutputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileOutputStream.FileOutputStream', or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileAppendTo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileCreateFlags] -> Maybe b -> m FileOutputStream
fileAppendTo a
file [FileCreateFlags]
flags Maybe b
cancellable = IO FileOutputStream -> m FileOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOutputStream -> m FileOutputStream)
-> IO FileOutputStream -> m FileOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileOutputStream -> IO () -> IO FileOutputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileOutputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
 -> IO (Ptr FileOutputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileOutputStream)
g_file_append_to Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileAppendTo" Ptr FileOutputStream
result
        FileOutputStream
result' <- ((ManagedPtr FileOutputStream -> FileOutputStream)
-> Ptr FileOutputStream -> IO FileOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileOutputStream -> FileOutputStream
Gio.FileOutputStream.FileOutputStream) Ptr FileOutputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileOutputStream -> IO FileOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileOutputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileAppendToMethodInfo
instance (signature ~ ([Gio.Flags.FileCreateFlags] -> Maybe (b) -> m Gio.FileOutputStream.FileOutputStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileAppendToMethodInfo a signature where
    overloadedMethod = fileAppendTo

instance O.OverloadedMethodInfo FileAppendToMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileAppendTo",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileAppendTo"
        }


#endif

-- method File::append_to_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_append_to_async" g_file_append_to_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously opens /@file@/ for appending.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileAppendTo' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileAppendToFinish' to get the result
-- of the operation.
fileAppendToAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileAppendToAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileAppendToAsync a
file [FileCreateFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_append_to_async Ptr File
file' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileAppendToAsyncMethodInfo
instance (signature ~ ([Gio.Flags.FileCreateFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileAppendToAsyncMethodInfo a signature where
    overloadedMethod = fileAppendToAsync

instance O.OverloadedMethodInfo FileAppendToAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileAppendToAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileAppendToAsync"
        }


#endif

-- method File::append_to_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileOutputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_append_to_finish" g_file_append_to_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileOutputStream.FileOutputStream)

-- | Finishes an asynchronous file append operation started with
-- 'GI.Gio.Interfaces.File.fileAppendToAsync'.
fileAppendToFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileOutputStream.FileOutputStream
    -- ^ __Returns:__ a valid t'GI.Gio.Objects.FileOutputStream.FileOutputStream'
    --     or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileAppendToFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileOutputStream
fileAppendToFinish a
file b
res = IO FileOutputStream -> m FileOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOutputStream -> m FileOutputStream)
-> IO FileOutputStream -> m FileOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileOutputStream -> IO () -> IO FileOutputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileOutputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
 -> IO (Ptr FileOutputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileOutputStream)
g_file_append_to_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileAppendToFinish" Ptr FileOutputStream
result
        FileOutputStream
result' <- ((ManagedPtr FileOutputStream -> FileOutputStream)
-> Ptr FileOutputStream -> IO FileOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileOutputStream -> FileOutputStream
Gio.FileOutputStream.FileOutputStream) Ptr FileOutputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileOutputStream -> IO FileOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileOutputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileAppendToFinishMethodInfo
instance (signature ~ (b -> m Gio.FileOutputStream.FileOutputStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileAppendToFinishMethodInfo a signature where
    overloadedMethod = fileAppendToFinish

instance O.OverloadedMethodInfo FileAppendToFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileAppendToFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileAppendToFinish"
        }


#endif

-- method File::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destination"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "destination #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCopyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "set of #GFileCopyFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "FileProgressCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "function to callback with\n    progress information, or %NULL if progress information is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data to pass to @progress_callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_copy" g_file_copy :: 
    Ptr File ->                             -- source : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- destination : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCopyFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_FileProgressCallback -> -- progress_callback : TInterface (Name {namespace = "Gio", name = "FileProgressCallback"})
    Ptr () ->                               -- progress_callback_data : TBasicType TPtr
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Copies the file /@source@/ to the location specified by /@destination@/.
-- Can not handle recursive copies of directories.
-- 
-- If the flag @/G_FILE_COPY_OVERWRITE/@ is specified an already
-- existing /@destination@/ file is overwritten.
-- 
-- If the flag @/G_FILE_COPY_NOFOLLOW_SYMLINKS/@ is specified then symlinks
-- will be copied as symlinks, otherwise the target of the
-- /@source@/ symlink will be copied.
-- 
-- If the flag @/G_FILE_COPY_ALL_METADATA/@ is specified then all the metadata
-- that is possible to copy is copied, not just the default subset (which,
-- for instance, does not include the owner, see t'GI.Gio.Objects.FileInfo.FileInfo').
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- If /@progressCallback@/ is not 'P.Nothing', then the operation can be monitored
-- by setting this to a t'GI.Gio.Callbacks.FileProgressCallback' function.
-- /@progressCallbackData@/ will be passed to this function. It is guaranteed
-- that this callback will be called after all data has been transferred with
-- the total number of bytes copied during the operation.
-- 
-- If the /@source@/ file does not exist, then the 'GI.Gio.Enums.IOErrorEnumNotFound' error
-- is returned, independent on the status of the /@destination@/.
-- 
-- If @/G_FILE_COPY_OVERWRITE/@ is not specified and the target exists, then
-- the error 'GI.Gio.Enums.IOErrorEnumExists' is returned.
-- 
-- If trying to overwrite a file over a directory, the 'GI.Gio.Enums.IOErrorEnumIsDirectory'
-- error is returned. If trying to overwrite a directory with a directory the
-- 'GI.Gio.Enums.IOErrorEnumWouldMerge' error is returned.
-- 
-- If the source is a directory and the target does not exist, or
-- @/G_FILE_COPY_OVERWRITE/@ is specified and the target is a file, then the
-- 'GI.Gio.Enums.IOErrorEnumWouldRecurse' error is returned.
-- 
-- If you are interested in copying the t'GI.Gio.Interfaces.File.File' object itself (not the on-disk
-- file), see 'GI.Gio.Interfaces.File.fileDup'.
fileCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@source@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@destination@/: destination t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCopyFlags]
    -- ^ /@flags@/: set of t'GI.Gio.Flags.FileCopyFlags'
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.FileProgressCallback)
    -- ^ /@progressCallback@/: function to callback with
    --     progress information, or 'P.Nothing' if progress information is not needed
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileCopy :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsFile b, IsCancellable c) =>
a
-> b
-> [FileCopyFlags]
-> Maybe c
-> Maybe FileProgressCallback
-> m ()
fileCopy a
source b
destination [FileCopyFlags]
flags Maybe c
cancellable Maybe FileProgressCallback
progressCallback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
source' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr File
destination' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
destination
    let flags' :: CUInt
flags' = [FileCopyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCopyFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_FileProgressCallback
maybeProgressCallback <- case Maybe FileProgressCallback
progressCallback of
        Maybe FileProgressCallback
Nothing -> FunPtr C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_FileProgressCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just FileProgressCallback
jProgressCallback -> do
            FunPtr C_FileProgressCallback
jProgressCallback' <- C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
Gio.Callbacks.mk_FileProgressCallback (Maybe (Ptr (FunPtr C_FileProgressCallback))
-> C_FileProgressCallback -> C_FileProgressCallback
Gio.Callbacks.wrap_FileProgressCallback Maybe (Ptr (FunPtr C_FileProgressCallback))
forall a. Maybe a
Nothing (FileProgressCallback -> C_FileProgressCallback
Gio.Callbacks.drop_closures_FileProgressCallback FileProgressCallback
jProgressCallback))
            FunPtr C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_FileProgressCallback
jProgressCallback'
    let progressCallbackData :: Ptr a
progressCallbackData = Ptr a
forall a. Ptr a
nullPtr
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr File
-> CUInt
-> Ptr Cancellable
-> FunPtr C_FileProgressCallback
-> Ptr ()
-> Ptr (Ptr GError)
-> IO CInt
g_file_copy Ptr File
source' Ptr File
destination' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_FileProgressCallback
maybeProgressCallback Ptr ()
forall a. Ptr a
progressCallbackData
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_FileProgressCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FileProgressCallback
maybeProgressCallback
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
destination
        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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_FileProgressCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FileProgressCallback
maybeProgressCallback
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCopyMethodInfo
instance (signature ~ (b -> [Gio.Flags.FileCopyFlags] -> Maybe (c) -> Maybe (Gio.Callbacks.FileProgressCallback) -> m ()), MonadIO m, IsFile a, IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileCopyMethodInfo a signature where
    overloadedMethod = fileCopy

instance O.OverloadedMethodInfo FileCopyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCopy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCopy"
        }


#endif

-- XXX Could not generate method File::copy_async
{-  Bad introspection data: ScopeTypeNotified without destructor! Callable
      { returnType = Nothing
      , returnMayBeNull = False
      , returnTransfer = TransferNothing
      , returnDocumentation =
          Documentation { rawDocText = Nothing , sinceVersion = Nothing }
      , args =
          [ Arg
              { argCName = "source"
              , argType = TInterface Name { namespace = "Gio" , name = "File" }
              , direction = DirectionIn
              , mayBeNull = False
              , argDoc =
                  Documentation
                    { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
              , argScope = ScopeTypeInvalid
              , argClosure = -1
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "destination"
              , argType = TInterface Name { namespace = "Gio" , name = "File" }
              , direction = DirectionIn
              , mayBeNull = False
              , argDoc =
                  Documentation
                    { rawDocText = Just "destination #GFile" , sinceVersion = Nothing }
              , argScope = ScopeTypeInvalid
              , argClosure = -1
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "flags"
              , argType =
                  TInterface Name { namespace = "Gio" , name = "FileCopyFlags" }
              , direction = DirectionIn
              , mayBeNull = False
              , argDoc =
                  Documentation
                    { rawDocText = Just "set of #GFileCopyFlags"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeInvalid
              , argClosure = -1
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "io_priority"
              , argType = TBasicType TInt
              , direction = DirectionIn
              , mayBeNull = False
              , argDoc =
                  Documentation
                    { rawDocText =
                        Just "the [I/O priority][io-priority] of the request"
                    , 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 "optional #GCancellable object,\n    %NULL to ignore"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeInvalid
              , argClosure = -1
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "progress_callback"
              , argType =
                  TInterface
                    Name { namespace = "Gio" , name = "FileProgressCallback" }
              , direction = DirectionIn
              , mayBeNull = True
              , argDoc =
                  Documentation
                    { rawDocText =
                        Just
                          "function to callback with progress\n    information, or %NULL if progress information is not needed"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeNotified
              , argClosure = 6
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "progress_callback_data"
              , argType = TBasicType TPtr
              , direction = DirectionIn
              , mayBeNull = True
              , argDoc =
                  Documentation
                    { rawDocText = Just "user data to pass to @progress_callback"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeInvalid
              , argClosure = 5
              , 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 #GAsyncReadyCallback to call when the request is satisfied"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeAsync
              , argClosure = 8
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          , Arg
              { argCName = "user_data"
              , argType = TBasicType TPtr
              , direction = DirectionIn
              , mayBeNull = True
              , argDoc =
                  Documentation
                    { rawDocText = Just "the data to pass to callback function"
                    , sinceVersion = Nothing
                    }
              , argScope = ScopeTypeInvalid
              , argClosure = 7
              , argDestroy = -1
              , argCallerAllocates = False
              , transfer = TransferNothing
              }
          ]
      , skipReturn = False
      , callableThrows = False
      , callableDeprecated = Nothing
      , callableDocumentation =
          Documentation
            { rawDocText =
                Just
                  "Copies the file @source to the location specified by @destination\nasynchronously. For details of the behaviour, see g_file_copy().\n\nIf @progress_callback is not %NULL, then that function that will be called\njust like in g_file_copy(). The callback will run in the default main context\nof the thread calling g_file_copy_async() \8212 the same context as @callback is\nrun in.\n\nWhen the operation is finished, @callback will be called. You can then call\ng_file_copy_finish() to get the result of the operation."
            , sinceVersion = Nothing
            }
      , callableResolvable = Just True
      }
-}
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data FileCopyAsyncMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "copyAsync" File) => O.OverloadedMethod FileCopyAsyncMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "copyAsync" File) => O.OverloadedMethodInfo FileCopyAsyncMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method File::copy_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile with attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destination"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile to copy attributes to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCopyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCopyFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_copy_attributes" g_file_copy_attributes :: 
    Ptr File ->                             -- source : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- destination : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCopyFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Copies the file attributes from /@source@/ to /@destination@/.
-- 
-- Normally only a subset of the file attributes are copied,
-- those that are copies in a normal file copy operation
-- (which for instance does not include e.g. owner). However
-- if @/G_FILE_COPY_ALL_METADATA/@ is specified in /@flags@/, then
-- all the metadata that is possible to copy is copied. This
-- is useful when implementing move by copy + delete source.
fileCopyAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@source@/: a t'GI.Gio.Interfaces.File.File' with attributes
    -> b
    -- ^ /@destination@/: a t'GI.Gio.Interfaces.File.File' to copy attributes to
    -> [Gio.Flags.FileCopyFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCopyFlags'
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileCopyAttributes :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsFile b, IsCancellable c) =>
a -> b -> [FileCopyFlags] -> Maybe c -> m ()
fileCopyAttributes a
source b
destination [FileCopyFlags]
flags Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
source' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr File
destination' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
destination
    let flags' :: CUInt
flags' = [FileCopyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCopyFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_copy_attributes Ptr File
source' Ptr File
destination' CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
destination
        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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCopyAttributesMethodInfo
instance (signature ~ (b -> [Gio.Flags.FileCopyFlags] -> Maybe (c) -> m ()), MonadIO m, IsFile a, IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileCopyAttributesMethodInfo a signature where
    overloadedMethod = fileCopyAttributes

instance O.OverloadedMethodInfo FileCopyAttributesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCopyAttributes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCopyAttributes"
        }


#endif

-- method File::copy_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_copy_finish" g_file_copy_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes copying the file started with 'GI.Gio.Interfaces.File.fileCopyAsync'.
fileCopyFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileCopyFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileCopyFinish a
file b
res = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_copy_finish Ptr File
file' Ptr AsyncResult
res'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCopyFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileCopyFinishMethodInfo a signature where
    overloadedMethod = fileCopyFinish

instance O.OverloadedMethodInfo FileCopyFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCopyFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCopyFinish"
        }


#endif

-- method File::create
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileOutputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_create" g_file_create :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileOutputStream.FileOutputStream)

-- | Creates a new file and returns an output stream for writing to it.
-- The file must not already exist.
-- 
-- By default files created are generally readable by everyone,
-- but if you pass @/G_FILE_CREATE_PRIVATE/@ in /@flags@/ the file
-- will be made readable only to the current user, to the level
-- that is supported on the target filesystem.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- If a file or directory with this name already exists the
-- 'GI.Gio.Enums.IOErrorEnumExists' error will be returned. Some file systems don\'t
-- allow all file names, and may return an 'GI.Gio.Enums.IOErrorEnumInvalidFilename'
-- error, and if the name is to long 'GI.Gio.Enums.IOErrorEnumFilenameTooLong' will
-- be returned. Other errors are possible too, and depend on what kind
-- of filesystem the file is on.
fileCreate ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileOutputStream.FileOutputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileOutputStream.FileOutputStream' for the newly created
    --     file, or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileCreate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileCreateFlags] -> Maybe b -> m FileOutputStream
fileCreate a
file [FileCreateFlags]
flags Maybe b
cancellable = IO FileOutputStream -> m FileOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOutputStream -> m FileOutputStream)
-> IO FileOutputStream -> m FileOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileOutputStream -> IO () -> IO FileOutputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileOutputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
 -> IO (Ptr FileOutputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileOutputStream)
g_file_create Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileCreate" Ptr FileOutputStream
result
        FileOutputStream
result' <- ((ManagedPtr FileOutputStream -> FileOutputStream)
-> Ptr FileOutputStream -> IO FileOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileOutputStream -> FileOutputStream
Gio.FileOutputStream.FileOutputStream) Ptr FileOutputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileOutputStream -> IO FileOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileOutputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCreateMethodInfo
instance (signature ~ ([Gio.Flags.FileCreateFlags] -> Maybe (b) -> m Gio.FileOutputStream.FileOutputStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileCreateMethodInfo a signature where
    overloadedMethod = fileCreate

instance O.OverloadedMethodInfo FileCreateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCreate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCreate"
        }


#endif

-- method File::create_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_create_async" g_file_create_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously creates a new file and returns an output stream
-- for writing to it. The file must not already exist.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileCreate' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileCreateFinish' to get the result
-- of the operation.
fileCreateAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileCreateAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileCreateAsync a
file [FileCreateFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_create_async Ptr File
file' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileCreateAsyncMethodInfo
instance (signature ~ ([Gio.Flags.FileCreateFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileCreateAsyncMethodInfo a signature where
    overloadedMethod = fileCreateAsync

instance O.OverloadedMethodInfo FileCreateAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCreateAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCreateAsync"
        }


#endif

-- method File::create_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileOutputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_create_finish" g_file_create_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileOutputStream.FileOutputStream)

-- | Finishes an asynchronous file create operation started with
-- 'GI.Gio.Interfaces.File.fileCreateAsync'.
fileCreateFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileOutputStream.FileOutputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileOutputStream.FileOutputStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileCreateFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileOutputStream
fileCreateFinish a
file b
res = IO FileOutputStream -> m FileOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOutputStream -> m FileOutputStream)
-> IO FileOutputStream -> m FileOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileOutputStream -> IO () -> IO FileOutputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileOutputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
 -> IO (Ptr FileOutputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileOutputStream)
g_file_create_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileCreateFinish" Ptr FileOutputStream
result
        FileOutputStream
result' <- ((ManagedPtr FileOutputStream -> FileOutputStream)
-> Ptr FileOutputStream -> IO FileOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileOutputStream -> FileOutputStream
Gio.FileOutputStream.FileOutputStream) Ptr FileOutputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileOutputStream -> IO FileOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileOutputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCreateFinishMethodInfo
instance (signature ~ (b -> m Gio.FileOutputStream.FileOutputStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileCreateFinishMethodInfo a signature where
    overloadedMethod = fileCreateFinish

instance O.OverloadedMethodInfo FileCreateFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCreateFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCreateFinish"
        }


#endif

-- method File::create_readwrite
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileIOStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_create_readwrite" g_file_create_readwrite :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileIOStream.FileIOStream)

-- | Creates a new file and returns a stream for reading and
-- writing to it. The file must not already exist.
-- 
-- By default files created are generally readable by everyone,
-- but if you pass @/G_FILE_CREATE_PRIVATE/@ in /@flags@/ the file
-- will be made readable only to the current user, to the level
-- that is supported on the target filesystem.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- If a file or directory with this name already exists, the
-- 'GI.Gio.Enums.IOErrorEnumExists' error will be returned. Some file systems don\'t
-- allow all file names, and may return an 'GI.Gio.Enums.IOErrorEnumInvalidFilename'
-- error, and if the name is too long, 'GI.Gio.Enums.IOErrorEnumFilenameTooLong'
-- will be returned. Other errors are possible too, and depend on what
-- kind of filesystem the file is on.
-- 
-- Note that in many non-local file cases read and write streams are
-- not supported, so make sure you really need to do read and write
-- streaming, rather than just opening for reading or writing.
-- 
-- /Since: 2.22/
fileCreateReadwrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileIOStream.FileIOStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileIOStream.FileIOStream' for the newly created
    --     file, or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileCreateReadwrite :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileCreateFlags] -> Maybe b -> m FileIOStream
fileCreateReadwrite a
file [FileCreateFlags]
flags Maybe b
cancellable = IO FileIOStream -> m FileIOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileIOStream -> m FileIOStream)
-> IO FileIOStream -> m FileIOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileIOStream -> IO () -> IO FileIOStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileIOStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileIOStream))
 -> IO (Ptr FileIOStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileIOStream)
g_file_create_readwrite Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileIOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileCreateReadwrite" Ptr FileIOStream
result
        FileIOStream
result' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileIOStream -> IO FileIOStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileIOStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCreateReadwriteMethodInfo
instance (signature ~ ([Gio.Flags.FileCreateFlags] -> Maybe (b) -> m Gio.FileIOStream.FileIOStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileCreateReadwriteMethodInfo a signature where
    overloadedMethod = fileCreateReadwrite

instance O.OverloadedMethodInfo FileCreateReadwriteMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCreateReadwrite",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCreateReadwrite"
        }


#endif

-- method File::create_readwrite_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_create_readwrite_async" g_file_create_readwrite_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously creates a new file and returns a stream
-- for reading and writing to it. The file must not already exist.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileCreateReadwrite' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileCreateReadwriteFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
fileCreateReadwriteAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileCreateReadwriteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileCreateReadwriteAsync a
file [FileCreateFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_create_readwrite_async Ptr File
file' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileCreateReadwriteAsyncMethodInfo
instance (signature ~ ([Gio.Flags.FileCreateFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileCreateReadwriteAsyncMethodInfo a signature where
    overloadedMethod = fileCreateReadwriteAsync

instance O.OverloadedMethodInfo FileCreateReadwriteAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCreateReadwriteAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCreateReadwriteAsync"
        }


#endif

-- method File::create_readwrite_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileIOStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_create_readwrite_finish" g_file_create_readwrite_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileIOStream.FileIOStream)

-- | Finishes an asynchronous file create operation started with
-- 'GI.Gio.Interfaces.File.fileCreateReadwriteAsync'.
-- 
-- /Since: 2.22/
fileCreateReadwriteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileIOStream.FileIOStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileIOStream.FileIOStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileCreateReadwriteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileIOStream
fileCreateReadwriteFinish a
file b
res = IO FileIOStream -> m FileIOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileIOStream -> m FileIOStream)
-> IO FileIOStream -> m FileIOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileIOStream -> IO () -> IO FileIOStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileIOStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileIOStream))
 -> IO (Ptr FileIOStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileIOStream)
g_file_create_readwrite_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileIOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileCreateReadwriteFinish" Ptr FileIOStream
result
        FileIOStream
result' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileIOStream -> IO FileIOStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileIOStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileCreateReadwriteFinishMethodInfo
instance (signature ~ (b -> m Gio.FileIOStream.FileIOStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileCreateReadwriteFinishMethodInfo a signature where
    overloadedMethod = fileCreateReadwriteFinish

instance O.OverloadedMethodInfo FileCreateReadwriteFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileCreateReadwriteFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileCreateReadwriteFinish"
        }


#endif

-- method File::delete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_delete" g_file_delete :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Deletes a file. If the /@file@/ is a directory, it will only be
-- deleted if it is empty. This has the same semantics as 'GI.GLib.Functions.unlink'.
-- 
-- If /@file@/ doesn’t exist, 'GI.Gio.Enums.IOErrorEnumNotFound' will be returned. This allows
-- for deletion to be implemented avoiding
-- <https://en.wikipedia.org/wiki/Time-of-check_to_time-of-use time-of-check to time-of-use races>:
-- >
-- >g_autoptr(GError) local_error = NULL;
-- >if (!g_file_delete (my_file, my_cancellable, &local_error) &&
-- >    !g_error_matches (local_error, G_IO_ERROR, G_IO_ERROR_NOT_FOUND))
-- >  {
-- >    // deletion failed for some reason other than the file not existing:
-- >    // so report the error
-- >    g_warning ("Failed to delete %s: %s",
-- >               g_file_peek_path (my_file), local_error->message);
-- >  }
-- 
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileDelete :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m ()
fileDelete a
file Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_file_delete Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDeleteMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileDeleteMethodInfo a signature where
    overloadedMethod = fileDelete

instance O.OverloadedMethodInfo FileDeleteMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileDelete",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileDelete"
        }


#endif

-- method File::delete_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_delete_async" g_file_delete_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously delete a file. If the /@file@/ is a directory, it will
-- only be deleted if it is empty.  This has the same semantics as
-- 'GI.GLib.Functions.unlink'.
-- 
-- /Since: 2.34/
fileDeleteAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileDeleteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileDeleteAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_delete_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileDeleteAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileDeleteAsyncMethodInfo a signature where
    overloadedMethod = fileDeleteAsync

instance O.OverloadedMethodInfo FileDeleteAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileDeleteAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileDeleteAsync"
        }


#endif

-- method File::delete_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_delete_finish" g_file_delete_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes deleting a file started with 'GI.Gio.Interfaces.File.fileDeleteAsync'.
-- 
-- /Since: 2.34/
fileDeleteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileDeleteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileDeleteFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_delete_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileDeleteFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileDeleteFinishMethodInfo a signature where
    overloadedMethod = fileDeleteFinish

instance O.OverloadedMethodInfo FileDeleteFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileDeleteFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileDeleteFinish"
        }


#endif

-- method File::dup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_dup" g_file_dup :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr File)

-- | Duplicates a t'GI.Gio.Interfaces.File.File' handle. This operation does not duplicate
-- the actual file or directory represented by the t'GI.Gio.Interfaces.File.File'; see
-- 'GI.Gio.Interfaces.File.fileCopy' if attempting to copy a file.
-- 
-- 'GI.Gio.Interfaces.File.fileDup' is useful when a second handle is needed to the same underlying
-- file, for use in a separate thread (t'GI.Gio.Interfaces.File.File' is not thread-safe). For use
-- within the same thread, use 'GI.GObject.Objects.Object.objectRef' to increment the existing object’s
-- reference count.
-- 
-- This call does no blocking I\/O.
fileDup ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m File
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File' that is a duplicate
    --     of the given t'GI.Gio.Interfaces.File.File'.
fileDup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m File
fileDup a
file = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr File
result <- Ptr File -> IO (Ptr File)
g_file_dup Ptr File
file'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileDup" Ptr File
result
    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
File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data FileDupMethodInfo
instance (signature ~ (m File), MonadIO m, IsFile a) => O.OverloadedMethod FileDupMethodInfo a signature where
    overloadedMethod = fileDup

instance O.OverloadedMethodInfo FileDupMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileDup",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileDup"
        }


#endif

-- method File::eject_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_eject_mountable" g_file_eject_mountable :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    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 ()

{-# DEPRECATED fileEjectMountable ["(Since version 2.22)","Use 'GI.Gio.Interfaces.File.fileEjectMountableWithOperation' instead."] #-}
-- | Starts an asynchronous eject on a mountable.
-- When this operation has completed, /@callback@/ will be called with
-- /@userUser@/ data, and the operation can be finalized with
-- 'GI.Gio.Interfaces.File.fileEjectMountableFinish'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileEjectMountable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileEjectMountable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileEjectMountable a
file [MountUnmountFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_eject_mountable Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileEjectMountableMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileEjectMountableMethodInfo a signature where
    overloadedMethod = fileEjectMountable

instance O.OverloadedMethodInfo FileEjectMountableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEjectMountable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEjectMountable"
        }


#endif

-- method File::eject_mountable_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_eject_mountable_finish" g_file_eject_mountable_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED fileEjectMountableFinish ["(Since version 2.22)","Use 'GI.Gio.Interfaces.File.fileEjectMountableWithOperationFinish'","    instead."] #-}
-- | Finishes an asynchronous eject operation started by
-- 'GI.Gio.Interfaces.File.fileEjectMountable'.
fileEjectMountableFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileEjectMountableFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileEjectMountableFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_eject_mountable_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileEjectMountableFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileEjectMountableFinishMethodInfo a signature where
    overloadedMethod = fileEjectMountableFinish

instance O.OverloadedMethodInfo FileEjectMountableFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEjectMountableFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEjectMountableFinish"
        }


#endif

-- method File::eject_mountable_with_operation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation,\n    or %NULL to avoid user interaction"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_eject_mountable_with_operation" g_file_eject_mountable_with_operation :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    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 ()

-- | Starts an asynchronous eject on a mountable.
-- When this operation has completed, /@callback@/ will be called with
-- /@userUser@/ data, and the operation can be finalized with
-- 'GI.Gio.Interfaces.File.fileEjectMountableWithOperationFinish'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- /Since: 2.22/
fileEjectMountableWithOperation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation',
    --     or 'P.Nothing' to avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileEjectMountableWithOperation :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileEjectMountableWithOperation a
file [MountUnmountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_eject_mountable_with_operation Ptr File
file' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileEjectMountableWithOperationMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileEjectMountableWithOperationMethodInfo a signature where
    overloadedMethod = fileEjectMountableWithOperation

instance O.OverloadedMethodInfo FileEjectMountableWithOperationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEjectMountableWithOperation",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEjectMountableWithOperation"
        }


#endif

-- method File::eject_mountable_with_operation_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_eject_mountable_with_operation_finish" g_file_eject_mountable_with_operation_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous eject operation started by
-- 'GI.Gio.Interfaces.File.fileEjectMountableWithOperation'.
-- 
-- /Since: 2.22/
fileEjectMountableWithOperationFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileEjectMountableWithOperationFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileEjectMountableWithOperationFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_eject_mountable_with_operation_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileEjectMountableWithOperationFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileEjectMountableWithOperationFinishMethodInfo a signature where
    overloadedMethod = fileEjectMountableWithOperationFinish

instance O.OverloadedMethodInfo FileEjectMountableWithOperationFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEjectMountableWithOperationFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEjectMountableWithOperationFinish"
        }


#endif

-- method File::enumerate_children
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an attribute query string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileEnumerator" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_enumerate_children" g_file_enumerate_children :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attributes : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileEnumerator.FileEnumerator)

-- | Gets the requested information about the files in a directory.
-- The result is a t'GI.Gio.Objects.FileEnumerator.FileEnumerator' object that will give out
-- t'GI.Gio.Objects.FileInfo.FileInfo' objects for all the files in the directory.
-- 
-- The /@attributes@/ value is a string that specifies the file
-- attributes that should be gathered. It is not an error if
-- it\'s not possible to read a particular requested attribute
-- from a file - it just won\'t be set. /@attributes@/ should
-- be a comma-separated list of attributes or attribute wildcards.
-- The wildcard \"*\" means all attributes, and a wildcard like
-- \"standard::*\" means all attributes in the standard namespace.
-- An example attribute query be \"standard::*,owner[user](#g:signal:user)\".
-- The standard attributes are available as defines, like
-- 'GI.Gio.Constants.FILE_ATTRIBUTE_STANDARD_NAME'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- If the file does not exist, the 'GI.Gio.Enums.IOErrorEnumNotFound' error will
-- be returned. If the file is not a directory, the 'GI.Gio.Enums.IOErrorEnumNotDirectory'
-- error will be returned. Other errors are possible too.
fileEnumerateChildren ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attributes@/: an attribute query string
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileEnumerator.FileEnumerator
    -- ^ __Returns:__ A t'GI.Gio.Objects.FileEnumerator.FileEnumerator' if successful,
    --     'P.Nothing' on error. Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileEnumerateChildren :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> [FileQueryInfoFlags] -> Maybe b -> m FileEnumerator
fileEnumerateChildren a
file Text
attributes [FileQueryInfoFlags]
flags Maybe b
cancellable = IO FileEnumerator -> m FileEnumerator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileEnumerator -> m FileEnumerator)
-> IO FileEnumerator -> m FileEnumerator
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileEnumerator -> IO () -> IO FileEnumerator
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileEnumerator
result <- (Ptr (Ptr GError) -> IO (Ptr FileEnumerator))
-> IO (Ptr FileEnumerator)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileEnumerator))
 -> IO (Ptr FileEnumerator))
-> (Ptr (Ptr GError) -> IO (Ptr FileEnumerator))
-> IO (Ptr FileEnumerator)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileEnumerator)
g_file_enumerate_children Ptr File
file' CString
attributes' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileEnumerator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileEnumerateChildren" Ptr FileEnumerator
result
        FileEnumerator
result' <- ((ManagedPtr FileEnumerator -> FileEnumerator)
-> Ptr FileEnumerator -> IO FileEnumerator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileEnumerator -> FileEnumerator
Gio.FileEnumerator.FileEnumerator) Ptr FileEnumerator
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
        FileEnumerator -> IO FileEnumerator
forall (m :: * -> *) a. Monad m => a -> m a
return FileEnumerator
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
     )

#if defined(ENABLE_OVERLOADING)
data FileEnumerateChildrenMethodInfo
instance (signature ~ (T.Text -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m Gio.FileEnumerator.FileEnumerator), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileEnumerateChildrenMethodInfo a signature where
    overloadedMethod = fileEnumerateChildren

instance O.OverloadedMethodInfo FileEnumerateChildrenMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEnumerateChildren",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEnumerateChildren"
        }


#endif

-- method File::enumerate_children_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an attribute query string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileQueryInfoFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the\n    request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_enumerate_children_async" g_file_enumerate_children_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attributes : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously gets the requested information about the files
-- in a directory. The result is a t'GI.Gio.Objects.FileEnumerator.FileEnumerator' object that will
-- give out t'GI.Gio.Objects.FileInfo.FileInfo' objects for all the files in the directory.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileEnumerateChildren' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called. You can
-- then call 'GI.Gio.Interfaces.File.fileEnumerateChildrenFinish' to get the result of
-- the operation.
fileEnumerateChildrenAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attributes@/: an attribute query string
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the
    --     request is satisfied
    -> m ()
fileEnumerateChildrenAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Text
-> [FileQueryInfoFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileEnumerateChildrenAsync a
file Text
attributes [FileQueryInfoFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CString
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_enumerate_children_async Ptr File
file' CString
attributes' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileEnumerateChildrenAsyncMethodInfo
instance (signature ~ (T.Text -> [Gio.Flags.FileQueryInfoFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileEnumerateChildrenAsyncMethodInfo a signature where
    overloadedMethod = fileEnumerateChildrenAsync

instance O.OverloadedMethodInfo FileEnumerateChildrenAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEnumerateChildrenAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEnumerateChildrenAsync"
        }


#endif

-- method File::enumerate_children_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileEnumerator" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_enumerate_children_finish" g_file_enumerate_children_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileEnumerator.FileEnumerator)

-- | Finishes an async enumerate children operation.
-- See 'GI.Gio.Interfaces.File.fileEnumerateChildrenAsync'.
fileEnumerateChildrenFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileEnumerator.FileEnumerator
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileEnumerator.FileEnumerator' or 'P.Nothing'
    --     if an error occurred.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileEnumerateChildrenFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileEnumerator
fileEnumerateChildrenFinish a
file b
res = IO FileEnumerator -> m FileEnumerator
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileEnumerator -> m FileEnumerator)
-> IO FileEnumerator -> m FileEnumerator
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileEnumerator -> IO () -> IO FileEnumerator
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileEnumerator
result <- (Ptr (Ptr GError) -> IO (Ptr FileEnumerator))
-> IO (Ptr FileEnumerator)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileEnumerator))
 -> IO (Ptr FileEnumerator))
-> (Ptr (Ptr GError) -> IO (Ptr FileEnumerator))
-> IO (Ptr FileEnumerator)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileEnumerator)
g_file_enumerate_children_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileEnumerator -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileEnumerateChildrenFinish" Ptr FileEnumerator
result
        FileEnumerator
result' <- ((ManagedPtr FileEnumerator -> FileEnumerator)
-> Ptr FileEnumerator -> IO FileEnumerator
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileEnumerator -> FileEnumerator
Gio.FileEnumerator.FileEnumerator) Ptr FileEnumerator
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileEnumerator -> IO FileEnumerator
forall (m :: * -> *) a. Monad m => a -> m a
return FileEnumerator
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileEnumerateChildrenFinishMethodInfo
instance (signature ~ (b -> m Gio.FileEnumerator.FileEnumerator), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileEnumerateChildrenFinishMethodInfo a signature where
    overloadedMethod = fileEnumerateChildrenFinish

instance O.OverloadedMethodInfo FileEnumerateChildrenFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEnumerateChildrenFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEnumerateChildrenFinish"
        }


#endif

-- method File::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file1"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file2"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second #GFile" , 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 "g_file_equal" g_file_equal :: 
    Ptr File ->                             -- file1 : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- file2 : TInterface (Name {namespace = "Gio", name = "File"})
    IO CInt

-- | Checks if the two given @/GFiles/@ refer to the same file.
-- 
-- Note that two @/GFiles/@ that differ can still refer to the same
-- file on the filesystem due to various forms of filename
-- aliasing.
-- 
-- This call does no blocking I\/O.
fileEqual ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b) =>
    a
    -- ^ /@file1@/: the first t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@file2@/: the second t'GI.Gio.Interfaces.File.File'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@file1@/ and /@file2@/ are equal.
fileEqual :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsFile b) =>
a -> b -> m Bool
fileEqual a
file1 b
file2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file1' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file1
    Ptr File
file2' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file2
    CInt
result <- Ptr File -> Ptr File -> IO CInt
g_file_equal Ptr File
file1' Ptr File
file2'
    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
file1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileEqualMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsFile a, IsFile b) => O.OverloadedMethod FileEqualMethodInfo a signature where
    overloadedMethod = fileEqual

instance O.OverloadedMethodInfo FileEqualMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileEqual",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileEqual"
        }


#endif

-- method File::find_enclosing_mount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Mount" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_find_enclosing_mount" g_file_find_enclosing_mount :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.Mount.Mount)

-- | Gets a t'GI.Gio.Interfaces.Mount.Mount' for the t'GI.Gio.Interfaces.File.File'.
-- 
-- t'GI.Gio.Interfaces.Mount.Mount' is returned only for user interesting locations, see
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'. If the t'GI.Gio.Structs.FileIface.FileIface' for /@file@/ does not have a @/mount/@,
-- /@error@/ will be set to 'GI.Gio.Enums.IOErrorEnumNotFound' and 'P.Nothing' @/will/@ be returned.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileFindEnclosingMount ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.Mount.Mount
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Mount.Mount' where the /@file@/ is located
    --     or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileFindEnclosingMount :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m Mount
fileFindEnclosingMount a
file Maybe b
cancellable = IO Mount -> m Mount
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mount -> m Mount) -> IO Mount -> m Mount
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Mount -> IO () -> IO Mount
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Mount
result <- (Ptr (Ptr GError) -> IO (Ptr Mount)) -> IO (Ptr Mount)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Mount)) -> IO (Ptr Mount))
-> (Ptr (Ptr GError) -> IO (Ptr Mount)) -> IO (Ptr Mount)
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr Mount)
g_file_find_enclosing_mount Ptr File
file' Ptr Cancellable
maybeCancellable
        Text -> Ptr Mount -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileFindEnclosingMount" Ptr Mount
result
        Mount
result' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Mount -> IO Mount
forall (m :: * -> *) a. Monad m => a -> m a
return Mount
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileFindEnclosingMountMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.Mount.Mount), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileFindEnclosingMountMethodInfo a signature where
    overloadedMethod = fileFindEnclosingMount

instance O.OverloadedMethodInfo FileFindEnclosingMountMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileFindEnclosingMount",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileFindEnclosingMount"
        }


#endif

-- method File::find_enclosing_mount_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_find_enclosing_mount_async" g_file_find_enclosing_mount_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously gets the mount for the file.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileFindEnclosingMount' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileFindEnclosingMountFinish' to
-- get the result of the operation.
fileFindEnclosingMountAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileFindEnclosingMountAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileFindEnclosingMountAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_find_enclosing_mount_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileFindEnclosingMountAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileFindEnclosingMountAsyncMethodInfo a signature where
    overloadedMethod = fileFindEnclosingMountAsync

instance O.OverloadedMethodInfo FileFindEnclosingMountAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileFindEnclosingMountAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileFindEnclosingMountAsync"
        }


#endif

-- method File::find_enclosing_mount_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "Mount" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_find_enclosing_mount_finish" g_file_find_enclosing_mount_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.Mount.Mount)

-- | Finishes an asynchronous find mount request.
-- See 'GI.Gio.Interfaces.File.fileFindEnclosingMountAsync'.
fileFindEnclosingMountFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.Mount.Mount
    -- ^ __Returns:__ t'GI.Gio.Interfaces.Mount.Mount' for given /@file@/ or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileFindEnclosingMountFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m Mount
fileFindEnclosingMountFinish a
file b
res = IO Mount -> m Mount
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mount -> m Mount) -> IO Mount -> m Mount
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO Mount -> IO () -> IO Mount
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Mount
result <- (Ptr (Ptr GError) -> IO (Ptr Mount)) -> IO (Ptr Mount)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Mount)) -> IO (Ptr Mount))
-> (Ptr (Ptr GError) -> IO (Ptr Mount)) -> IO (Ptr Mount)
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr Mount)
g_file_find_enclosing_mount_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr Mount -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileFindEnclosingMountFinish" Ptr Mount
result
        Mount
result' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Mount -> IO Mount
forall (m :: * -> *) a. Monad m => a -> m a
return Mount
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileFindEnclosingMountFinishMethodInfo
instance (signature ~ (b -> m Gio.Mount.Mount), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileFindEnclosingMountFinishMethodInfo a signature where
    overloadedMethod = fileFindEnclosingMountFinish

instance O.OverloadedMethodInfo FileFindEnclosingMountFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileFindEnclosingMountFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileFindEnclosingMountFinish"
        }


#endif

-- method File::get_basename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_file_get_basename" g_file_get_basename :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Gets the base name (the last component of the path) for a given t'GI.Gio.Interfaces.File.File'.
-- 
-- If called for the top level of a system (such as the filesystem root
-- or a uri like sftp:\/\/host\/) it will return a single directory separator
-- (and on Windows, possibly a drive letter).
-- 
-- The base name is a byte string (not UTF-8). It has no defined encoding
-- or rules other than it may not contain zero bytes.  If you want to use
-- filenames in a user interface you should use the display name that you
-- can get by requesting the 'GI.Gio.Constants.FILE_ATTRIBUTE_STANDARD_DISPLAY_NAME'
-- attribute with 'GI.Gio.Interfaces.File.fileQueryInfo'.
-- 
-- This call does no blocking I\/O.
fileGetBasename ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m (Maybe [Char])
    -- ^ __Returns:__ string containing the t'GI.Gio.Interfaces.File.File'\'s
    --     base name, or 'P.Nothing' if given t'GI.Gio.Interfaces.File.File' is invalid. The returned string
    --     should be freed with 'GI.GLib.Functions.free' when no longer needed.
fileGetBasename :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m (Maybe [Char])
fileGetBasename a
file = IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
result <- Ptr File -> IO CString
g_file_get_basename Ptr File
file'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data FileGetBasenameMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsFile a) => O.OverloadedMethod FileGetBasenameMethodInfo a signature where
    overloadedMethod = fileGetBasename

instance O.OverloadedMethodInfo FileGetBasenameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetBasename",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetBasename"
        }


#endif

-- method File::get_child
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "string containing the child's basename"
--                 , 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 "g_file_get_child" g_file_get_child :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- name : TBasicType TFileName
    IO (Ptr File)

-- | Gets a child of /@file@/ with basename equal to /@name@/.
-- 
-- Note that the file with that specific name might not exist, but
-- you can still have a t'GI.Gio.Interfaces.File.File' that points to it. You can use this
-- for instance to create that file.
-- 
-- This call does no blocking I\/O.
fileGetChild ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Char]
    -- ^ /@name@/: string containing the child\'s basename
    -> m File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' to a child specified by /@name@/.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
fileGetChild :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> [Char] -> m File
fileGetChild a
file [Char]
name = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
name' <- [Char] -> IO CString
stringToCString [Char]
name
    Ptr File
result <- Ptr File -> CString -> IO (Ptr File)
g_file_get_child Ptr File
file' CString
name'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileGetChild" Ptr File
result
    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
File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data FileGetChildMethodInfo
instance (signature ~ ([Char] -> m File), MonadIO m, IsFile a) => O.OverloadedMethod FileGetChildMethodInfo a signature where
    overloadedMethod = fileGetChild

instance O.OverloadedMethodInfo FileGetChildMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetChild",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetChild"
        }


#endif

-- method File::get_child_for_display_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "display_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "string to a possible child"
--                 , 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 "g_file_get_child_for_display_name" g_file_get_child_for_display_name :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- display_name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr File)

-- | Gets the child of /@file@/ for a given /@displayName@/ (i.e. a UTF-8
-- version of the name). If this function fails, it returns 'P.Nothing'
-- and /@error@/ will be set. This is very useful when constructing a
-- t'GI.Gio.Interfaces.File.File' for a new file and the user entered the filename in the
-- user interface, for instance when you select a directory and
-- type a filename in the file selector.
-- 
-- This call does no blocking I\/O.
fileGetChildForDisplayName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@displayName@/: string to a possible child
    -> m File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' to the specified child, or
    --     'P.Nothing' if the display name couldn\'t be converted.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileGetChildForDisplayName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> Text -> m File
fileGetChildForDisplayName a
file Text
displayName = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
displayName' <- Text -> IO CString
textToCString Text
displayName
    IO File -> IO () -> IO 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 File -> CString -> Ptr (Ptr GError) -> IO (Ptr File)
g_file_get_child_for_display_name Ptr File
file' CString
displayName'
        Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileGetChildForDisplayName" Ptr File
result
        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
File) Ptr File
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
displayName'
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
displayName'
     )

#if defined(ENABLE_OVERLOADING)
data FileGetChildForDisplayNameMethodInfo
instance (signature ~ (T.Text -> m File), MonadIO m, IsFile a) => O.OverloadedMethod FileGetChildForDisplayNameMethodInfo a signature where
    overloadedMethod = fileGetChildForDisplayName

instance O.OverloadedMethodInfo FileGetChildForDisplayNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetChildForDisplayName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetChildForDisplayName"
        }


#endif

-- method File::get_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_get_parent" g_file_get_parent :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr File)

-- | Gets the parent directory for the /@file@/.
-- If the /@file@/ represents the root directory of the
-- file system, then 'P.Nothing' will be returned.
-- 
-- This call does no blocking I\/O.
fileGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m (Maybe File)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' structure to the
    --     parent of the given t'GI.Gio.Interfaces.File.File' or 'P.Nothing' if there is no parent. Free
    --     the returned object with 'GI.GObject.Objects.Object.objectUnref'.
fileGetParent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m (Maybe File)
fileGetParent a
file = IO (Maybe File) -> m (Maybe File)
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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr File
result <- Ptr File -> IO (Ptr File)
g_file_get_parent Ptr File
file'
    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
File) Ptr File
result'
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe File -> IO (Maybe File)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data FileGetParentMethodInfo
instance (signature ~ (m (Maybe File)), MonadIO m, IsFile a) => O.OverloadedMethod FileGetParentMethodInfo a signature where
    overloadedMethod = fileGetParent

instance O.OverloadedMethodInfo FileGetParentMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetParent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetParent"
        }


#endif

-- method File::get_parse_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_get_parse_name" g_file_get_parse_name :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Gets the parse name of the /@file@/.
-- A parse name is a UTF-8 string that describes the
-- file such that one can get the t'GI.Gio.Interfaces.File.File' back using
-- 'GI.Gio.Functions.fileParseName'.
-- 
-- This is generally used to show the t'GI.Gio.Interfaces.File.File' as a nice
-- full-pathname kind of string in a user interface,
-- like in a location entry.
-- 
-- For local files with names that can safely be converted
-- to UTF-8 the pathname is used, otherwise the IRI is used
-- (a form of URI that allows UTF-8 characters unescaped).
-- 
-- This call does no blocking I\/O.
fileGetParseName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m T.Text
    -- ^ __Returns:__ a string containing the t'GI.Gio.Interfaces.File.File'\'s parse name.
    --     The returned string should be freed with 'GI.GLib.Functions.free'
    --     when no longer needed.
fileGetParseName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Text
fileGetParseName a
file = IO Text -> m Text
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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
result <- Ptr File -> IO CString
g_file_get_parse_name Ptr File
file'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileGetParseName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FileGetParseNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFile a) => O.OverloadedMethod FileGetParseNameMethodInfo a signature where
    overloadedMethod = fileGetParseName

instance O.OverloadedMethodInfo FileGetParseNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetParseName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetParseName"
        }


#endif

-- method File::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_file_get_path" g_file_get_path :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Gets the local pathname for t'GI.Gio.Interfaces.File.File', if one exists. If non-'P.Nothing', this is
-- guaranteed to be an absolute, canonical path. It might contain symlinks.
-- 
-- This call does no blocking I\/O.
fileGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m (Maybe [Char])
    -- ^ __Returns:__ string containing the t'GI.Gio.Interfaces.File.File'\'s path,
    --     or 'P.Nothing' if no such path exists. The returned string should be freed
    --     with 'GI.GLib.Functions.free' when no longer needed.
fileGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m (Maybe [Char])
fileGetPath a
file = IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
result <- Ptr File -> IO CString
g_file_get_path Ptr File
file'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data FileGetPathMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsFile a) => O.OverloadedMethod FileGetPathMethodInfo a signature where
    overloadedMethod = fileGetPath

instance O.OverloadedMethodInfo FileGetPathMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetPath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetPath"
        }


#endif

-- method File::get_relative_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "descendant"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_file_get_relative_path" g_file_get_relative_path :: 
    Ptr File ->                             -- parent : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- descendant : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Gets the path for /@descendant@/ relative to /@parent@/.
-- 
-- This call does no blocking I\/O.
fileGetRelativePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b) =>
    a
    -- ^ /@parent@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@descendant@/: input t'GI.Gio.Interfaces.File.File'
    -> m (Maybe [Char])
    -- ^ __Returns:__ string with the relative path from
    --     /@descendant@/ to /@parent@/, or 'P.Nothing' if /@descendant@/ doesn\'t have /@parent@/ as
    --     prefix. The returned string should be freed with 'GI.GLib.Functions.free' when
    --     no longer needed.
fileGetRelativePath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsFile b) =>
a -> b -> m (Maybe [Char])
fileGetRelativePath a
parent b
descendant = IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
parent' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
parent
    Ptr File
descendant' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
descendant
    CString
result <- Ptr File -> Ptr File -> IO CString
g_file_get_relative_path Ptr File
parent' Ptr File
descendant'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
parent
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
descendant
    Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data FileGetRelativePathMethodInfo
instance (signature ~ (b -> m (Maybe [Char])), MonadIO m, IsFile a, IsFile b) => O.OverloadedMethod FileGetRelativePathMethodInfo a signature where
    overloadedMethod = fileGetRelativePath

instance O.OverloadedMethodInfo FileGetRelativePathMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetRelativePath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetRelativePath"
        }


#endif

-- method File::get_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_get_uri" g_file_get_uri :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Gets the URI for the /@file@/.
-- 
-- This call does no blocking I\/O.
fileGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m T.Text
    -- ^ __Returns:__ a string containing the t'GI.Gio.Interfaces.File.File'\'s URI.
    --     The returned string should be freed with 'GI.GLib.Functions.free'
    --     when no longer needed.
fileGetUri :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Text
fileGetUri a
file = IO Text -> m Text
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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
result <- Ptr File -> IO CString
g_file_get_uri Ptr File
file'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileGetUri" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FileGetUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFile a) => O.OverloadedMethod FileGetUriMethodInfo a signature where
    overloadedMethod = fileGetUri

instance O.OverloadedMethodInfo FileGetUriMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetUri",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetUri"
        }


#endif

-- method File::get_uri_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_get_uri_scheme" g_file_get_uri_scheme :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Gets the URI scheme for a t'GI.Gio.Interfaces.File.File'.
-- RFC 3986 decodes the scheme as:
-- >
-- >URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
-- 
-- Common schemes include \"file\", \"http\", \"ftp\", etc.
-- 
-- This call does no blocking I\/O.
fileGetUriScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m T.Text
    -- ^ __Returns:__ a string containing the URI scheme for the given
    --     t'GI.Gio.Interfaces.File.File'. The returned string should be freed with 'GI.GLib.Functions.free'
    --     when no longer needed.
fileGetUriScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Text
fileGetUriScheme a
file = IO Text -> m Text
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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
result <- Ptr File -> IO CString
g_file_get_uri_scheme Ptr File
file'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileGetUriScheme" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data FileGetUriSchemeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsFile a) => O.OverloadedMethod FileGetUriSchemeMethodInfo a signature where
    overloadedMethod = fileGetUriScheme

instance O.OverloadedMethodInfo FileGetUriSchemeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileGetUriScheme",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileGetUriScheme"
        }


#endif

-- method File::has_parent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the parent to check for, or %NULL"
--                 , 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 "g_file_has_parent" g_file_has_parent :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- parent : TInterface (Name {namespace = "Gio", name = "File"})
    IO CInt

-- | Checks if /@file@/ has a parent, and optionally, if it is /@parent@/.
-- 
-- If /@parent@/ is 'P.Nothing' then this function returns 'P.True' if /@file@/ has any
-- parent at all.  If /@parent@/ is non-'P.Nothing' then 'P.True' is only returned
-- if /@file@/ is an immediate child of /@parent@/.
-- 
-- /Since: 2.24/
fileHasParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@parent@/: the parent to check for, or 'P.Nothing'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@file@/ is an immediate child of /@parent@/ (or any parent in
    --          the case that /@parent@/ is 'P.Nothing').
fileHasParent :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsFile b) =>
a -> Maybe b -> m Bool
fileHasParent a
file Maybe b
parent = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr File
maybeParent <- case Maybe b
parent of
        Maybe b
Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just b
jParent -> do
            Ptr File
jParent' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jParent
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jParent'
    CInt
result <- Ptr File -> Ptr File -> IO CInt
g_file_has_parent Ptr File
file' Ptr File
maybeParent
    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
file
    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
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileHasParentMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsFile a, IsFile b) => O.OverloadedMethod FileHasParentMethodInfo a signature where
    overloadedMethod = fileHasParent

instance O.OverloadedMethodInfo FileHasParentMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileHasParent",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileHasParent"
        }


#endif

-- method File::has_prefix
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "prefix"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_has_prefix" g_file_has_prefix :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- prefix : TInterface (Name {namespace = "Gio", name = "File"})
    IO CInt

-- | Checks whether /@file@/ has the prefix specified by /@prefix@/.
-- 
-- In other words, if the names of initial elements of /@file@/\'s
-- pathname match /@prefix@/. Only full pathname elements are matched,
-- so a path like \/foo is not considered a prefix of \/foobar, only
-- of \/foo\/bar.
-- 
-- A t'GI.Gio.Interfaces.File.File' is not a prefix of itself. If you want to check for
-- equality, use 'GI.Gio.Interfaces.File.fileEqual'.
-- 
-- This call does no I\/O, as it works purely on names. As such it can
-- sometimes return 'P.False' even if /@file@/ is inside a /@prefix@/ (from a
-- filesystem point of view), because the prefix of /@file@/ is an alias
-- of /@prefix@/.
fileHasPrefix ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@prefix@/: input t'GI.Gio.Interfaces.File.File'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@file@/\'s parent, grandparent, etc is /@prefix@/,
    --     'P.False' otherwise.
fileHasPrefix :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsFile b) =>
a -> b -> m Bool
fileHasPrefix a
file b
prefix = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr File
prefix' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
prefix
    CInt
result <- Ptr File -> Ptr File -> IO CInt
g_file_has_prefix Ptr File
file' Ptr File
prefix'
    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
file
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
prefix
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileHasPrefixMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsFile a, IsFile b) => O.OverloadedMethod FileHasPrefixMethodInfo a signature where
    overloadedMethod = fileHasPrefix

instance O.OverloadedMethodInfo FileHasPrefixMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileHasPrefix",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileHasPrefix"
        }


#endif

-- method File::has_uri_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri_scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing a URI scheme"
--                 , 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 "g_file_has_uri_scheme" g_file_has_uri_scheme :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- uri_scheme : TBasicType TUTF8
    IO CInt

-- | Checks to see if a t'GI.Gio.Interfaces.File.File' has a given URI scheme.
-- 
-- This call does no blocking I\/O.
fileHasUriScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@uriScheme@/: a string containing a URI scheme
    -> m Bool
    -- ^ __Returns:__ 'P.True' if t'GI.Gio.Interfaces.File.File'\'s backend supports the
    --     given URI scheme, 'P.False' if URI scheme is 'P.Nothing',
    --     not supported, or t'GI.Gio.Interfaces.File.File' is invalid.
fileHasUriScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> Text -> m Bool
fileHasUriScheme a
file Text
uriScheme = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
uriScheme' <- Text -> IO CString
textToCString Text
uriScheme
    CInt
result <- Ptr File -> CString -> IO CInt
g_file_has_uri_scheme Ptr File
file' CString
uriScheme'
    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
file
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uriScheme'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileHasUriSchemeMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m, IsFile a) => O.OverloadedMethod FileHasUriSchemeMethodInfo a signature where
    overloadedMethod = fileHasUriScheme

instance O.OverloadedMethodInfo FileHasUriSchemeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileHasUriScheme",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileHasUriScheme"
        }


#endif

-- method File::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#gconstpointer to a #GFile"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "g_file_hash" g_file_hash :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO Word32

-- | Creates a hash value for a t'GI.Gio.Interfaces.File.File'.
-- 
-- This call does no blocking I\/O.
fileHash ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: @/gconstpointer/@ to a t'GI.Gio.Interfaces.File.File'
    -> m Word32
    -- ^ __Returns:__ 0 if /@file@/ is not a valid t'GI.Gio.Interfaces.File.File', otherwise an
    --     integer that can be used as hash value for the t'GI.Gio.Interfaces.File.File'.
    --     This function is intended for easily hashing a t'GI.Gio.Interfaces.File.File' to
    --     add to a t'GI.GLib.Structs.HashTable.HashTable' or similar data structure.
fileHash :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Word32
fileHash a
file = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Word32
result <- Ptr File -> IO Word32
g_file_hash Ptr File
file'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data FileHashMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsFile a) => O.OverloadedMethod FileHashMethodInfo a signature where
    overloadedMethod = fileHash

instance O.OverloadedMethodInfo FileHashMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileHash",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileHash"
        }


#endif

-- method File::is_native
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_is_native" g_file_is_native :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CInt

-- | Checks to see if a file is native to the platform.
-- 
-- A native file is one expressed in the platform-native filename format,
-- e.g. \"C:\\Windows\" or \"\/usr\/bin\/\". This does not mean the file is local,
-- as it might be on a locally mounted remote filesystem.
-- 
-- On some systems non-native files may be available using the native
-- filesystem via a userspace filesystem (FUSE), in these cases this call
-- will return 'P.False', but 'GI.Gio.Interfaces.File.fileGetPath' will still return a native path.
-- 
-- This call does no blocking I\/O.
fileIsNative ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@file@/ is native
fileIsNative :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Bool
fileIsNative a
file = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CInt
result <- Ptr File -> IO CInt
g_file_is_native Ptr File
file'
    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
file
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileIsNativeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFile a) => O.OverloadedMethod FileIsNativeMethodInfo a signature where
    overloadedMethod = fileIsNative

instance O.OverloadedMethodInfo FileIsNativeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileIsNative",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileIsNative"
        }


#endif

-- method File::load_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , 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 or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag_out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the current\n    entity tag for the file, or %NULL if the entity tag is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_load_bytes" g_file_load_bytes :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr CString ->                          -- etag_out : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GLib.Bytes.Bytes)

-- | Loads the contents of /@file@/ and returns it as t'GI.GLib.Structs.Bytes.Bytes'.
-- 
-- If /@file@/ is a resource:\/\/ based URI, the resulting bytes will reference the
-- embedded resource instead of a copy. Otherwise, this is equivalent to calling
-- 'GI.Gio.Interfaces.File.fileLoadContents' and 'GI.GLib.Structs.Bytes.bytesNewTake'.
-- 
-- For resources, /@etagOut@/ will be set to 'P.Nothing'.
-- 
-- The data contained in the resulting t'GI.GLib.Structs.Bytes.Bytes' is always zero-terminated, but
-- this is not included in the t'GI.GLib.Structs.Bytes.Bytes' length. The resulting t'GI.GLib.Structs.Bytes.Bytes' should be
-- freed with 'GI.GLib.Structs.Bytes.bytesUnref' when no longer in use.
-- 
-- /Since: 2.56/
fileLoadBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> m ((GLib.Bytes.Bytes, Maybe T.Text))
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes' or 'P.Nothing' and /@error@/ is set /(Can throw 'Data.GI.Base.GError.GError')/
fileLoadBytes :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m (Bytes, Maybe Text)
fileLoadBytes a
file Maybe b
cancellable = IO (Bytes, Maybe Text) -> m (Bytes, Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bytes, Maybe Text) -> m (Bytes, Maybe Text))
-> IO (Bytes, Maybe Text) -> m (Bytes, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr CString
etagOut <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (Bytes, Maybe Text) -> IO () -> IO (Bytes, Maybe Text)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Bytes
result <- (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes))
-> (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Cancellable
-> Ptr CString
-> Ptr (Ptr GError)
-> IO (Ptr Bytes)
g_file_load_bytes Ptr File
file' Ptr Cancellable
maybeCancellable Ptr CString
etagOut
        Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoadBytes" Ptr Bytes
result
        Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
        CString
etagOut' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
etagOut
        Maybe Text
maybeEtagOut' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
etagOut' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
etagOut'' -> do
            Text
etagOut''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
etagOut''
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
etagOut'''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
etagOut'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
        (Bytes, Maybe Text) -> IO (Bytes, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
result', Maybe Text
maybeEtagOut')
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
     )

#if defined(ENABLE_OVERLOADING)
data FileLoadBytesMethodInfo
instance (signature ~ (Maybe (b) -> m ((GLib.Bytes.Bytes, Maybe T.Text))), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileLoadBytesMethodInfo a signature where
    overloadedMethod = fileLoadBytes

instance O.OverloadedMethodInfo FileLoadBytesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadBytes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadBytes"
        }


#endif

-- method File::load_bytes_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , 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 or %NULL"
--                 , 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 #GAsyncReadyCallback to call when the\n    request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_load_bytes_async" g_file_load_bytes_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    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 ()

-- | Asynchronously loads the contents of /@file@/ as t'GI.GLib.Structs.Bytes.Bytes'.
-- 
-- If /@file@/ is a resource:\/\/ based URI, the resulting bytes will reference the
-- embedded resource instead of a copy. Otherwise, this is equivalent to calling
-- 'GI.Gio.Interfaces.File.fileLoadContentsAsync' and 'GI.GLib.Structs.Bytes.bytesNewTake'.
-- 
-- /@callback@/ should call 'GI.Gio.Interfaces.File.fileLoadBytesFinish' to get the result of this
-- asynchronous operation.
-- 
-- See 'GI.Gio.Interfaces.File.fileLoadBytes' for more information.
-- 
-- /Since: 2.56/
fileLoadBytesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the
    --     request is satisfied
    -> m ()
fileLoadBytesAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileLoadBytesAsync a
file Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_load_bytes_async Ptr File
file' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileLoadBytesAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileLoadBytesAsyncMethodInfo a signature where
    overloadedMethod = fileLoadBytesAsync

instance O.OverloadedMethodInfo FileLoadBytesAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadBytesAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadBytesAsync"
        }


#endif

-- method File::load_bytes_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , 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 provided to the callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag_out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the current\n    entity tag for the file, or %NULL if the entity tag is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_load_bytes_finish" g_file_load_bytes_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CString ->                          -- etag_out : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr GLib.Bytes.Bytes)

-- | Completes an asynchronous request to 'GI.Gio.Interfaces.File.fileLoadBytesAsync'.
-- 
-- For resources, /@etagOut@/ will be set to 'P.Nothing'.
-- 
-- The data contained in the resulting t'GI.GLib.Structs.Bytes.Bytes' is always zero-terminated, but
-- this is not included in the t'GI.GLib.Structs.Bytes.Bytes' length. The resulting t'GI.GLib.Structs.Bytes.Bytes' should be
-- freed with 'GI.GLib.Structs.Bytes.bytesUnref' when no longer in use.
-- 
-- See 'GI.Gio.Interfaces.File.fileLoadBytes' for more information.
-- 
-- /Since: 2.56/
fileLoadBytesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult' provided to the callback
    -> m ((GLib.Bytes.Bytes, Maybe T.Text))
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes' or 'P.Nothing' and /@error@/ is set /(Can throw 'Data.GI.Base.GError.GError')/
fileLoadBytesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m (Bytes, Maybe Text)
fileLoadBytesFinish a
file b
result_ = IO (Bytes, Maybe Text) -> m (Bytes, Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bytes, Maybe Text) -> m (Bytes, Maybe Text))
-> IO (Bytes, Maybe Text) -> m (Bytes, Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr CString
etagOut <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (Bytes, Maybe Text) -> IO () -> IO (Bytes, Maybe Text)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Bytes
result <- (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes))
-> (Ptr (Ptr GError) -> IO (Ptr Bytes)) -> IO (Ptr Bytes)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult
-> Ptr CString
-> Ptr (Ptr GError)
-> IO (Ptr Bytes)
g_file_load_bytes_finish Ptr File
file' Ptr AsyncResult
result_' Ptr CString
etagOut
        Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileLoadBytesFinish" Ptr Bytes
result
        Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
        CString
etagOut' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
etagOut
        Maybe Text
maybeEtagOut' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
etagOut' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
etagOut'' -> do
            Text
etagOut''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
etagOut''
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
etagOut'''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
etagOut'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
        (Bytes, Maybe Text) -> IO (Bytes, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
result', Maybe Text
maybeEtagOut')
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
     )

#if defined(ENABLE_OVERLOADING)
data FileLoadBytesFinishMethodInfo
instance (signature ~ (b -> m ((GLib.Bytes.Bytes, Maybe T.Text))), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileLoadBytesFinishMethodInfo a signature where
    overloadedMethod = fileLoadBytesFinish

instance O.OverloadedMethodInfo FileLoadBytesFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadBytesFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadBytesFinish"
        }


#endif

-- method File::load_contents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to place the contents of the file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the length of the contents of the file,\n   or %NULL if the length is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "etag_out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the current entity tag for the file,\n   or %NULL if the entity tag is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "a location to place the length of the contents of the file,\n   or %NULL if the length is not needed"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_load_contents" g_file_load_contents :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr Word8) ->                      -- contents : TCArray False (-1) 3 (TBasicType TUInt8)
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr CString ->                          -- etag_out : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Loads the content of the file into memory. The data is always
-- zero-terminated, but this is not included in the resultant /@length@/.
-- The returned /@contents@/ should be freed with 'GI.GLib.Functions.free' when no longer
-- needed.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileLoadContents ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m ((ByteString, T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileLoadContents :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m (ByteString, Text)
fileLoadContents a
file Maybe b
cancellable = IO (ByteString, Text) -> m (ByteString, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, Text) -> m (ByteString, Text))
-> IO (ByteString, Text) -> m (ByteString, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    Ptr (Ptr Word8)
contents <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CString
etagOut <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (ByteString, Text) -> IO () -> IO (ByteString, Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Cancellable
-> Ptr (Ptr Word8)
-> Ptr Word64
-> Ptr CString
-> Ptr (Ptr GError)
-> IO CInt
g_file_load_contents Ptr File
file' Ptr Cancellable
maybeCancellable Ptr (Ptr Word8)
contents Ptr Word64
length_ Ptr CString
etagOut
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        Ptr Word8
contents' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
contents
        ByteString
contents'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
contents'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
contents'
        CString
etagOut' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
etagOut
        Text
etagOut'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
etagOut'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
etagOut'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
contents
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
        (ByteString, Text) -> IO (ByteString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
contents'', Text
etagOut'')
     ) (do
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
contents
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
     )

#if defined(ENABLE_OVERLOADING)
data FileLoadContentsMethodInfo
instance (signature ~ (Maybe (b) -> m ((ByteString, T.Text))), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileLoadContentsMethodInfo a signature where
    overloadedMethod = fileLoadContents

instance O.OverloadedMethodInfo FileLoadContentsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadContents",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadContents"
        }


#endif

-- method File::load_contents_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object, %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_load_contents_async" g_file_load_contents_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    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 ()

-- | Starts an asynchronous load of the /@file@/\'s contents.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileLoadContents' which is
-- the synchronous version of this call.
-- 
-- When the load operation has completed, /@callback@/ will be called
-- with /@user@/ data. To finish the operation, call
-- 'GI.Gio.Interfaces.File.fileLoadContentsFinish' with the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' returned by
-- the /@callback@/.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileLoadContentsAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    -> m ()
fileLoadContentsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileLoadContentsAsync a
file Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_load_contents_async Ptr File
file' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileLoadContentsAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileLoadContentsAsyncMethodInfo a signature where
    overloadedMethod = fileLoadContentsAsync

instance O.OverloadedMethodInfo FileLoadContentsAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadContentsAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadContentsAsync"
        }


#endif

-- method File::load_contents_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to place the contents of the file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the length of the contents of the file,\n    or %NULL if the length is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "etag_out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the current entity tag for the file,\n    or %NULL if the entity tag is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "a location to place the length of the contents of the file,\n    or %NULL if the length is not needed"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_load_contents_finish" g_file_load_contents_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr Word8) ->                      -- contents : TCArray False (-1) 3 (TBasicType TUInt8)
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr CString ->                          -- etag_out : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous load of the /@file@/\'s contents.
-- The contents are placed in /@contents@/, and /@length@/ is set to the
-- size of the /@contents@/ string. The /@contents@/ should be freed with
-- 'GI.GLib.Functions.free' when no longer needed. If /@etagOut@/ is present, it will be
-- set to the new entity tag for the /@file@/.
fileLoadContentsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ((ByteString, T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileLoadContentsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m (ByteString, Text)
fileLoadContentsFinish a
file b
res = IO (ByteString, Text) -> m (ByteString, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, Text) -> m (ByteString, Text))
-> IO (ByteString, Text) -> m (ByteString, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    Ptr (Ptr Word8)
contents <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CString
etagOut <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (ByteString, Text) -> IO () -> IO (ByteString, Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult
-> Ptr (Ptr Word8)
-> Ptr Word64
-> Ptr CString
-> Ptr (Ptr GError)
-> IO CInt
g_file_load_contents_finish Ptr File
file' Ptr AsyncResult
res' Ptr (Ptr Word8)
contents Ptr Word64
length_ Ptr CString
etagOut
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        Ptr Word8
contents' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
contents
        ByteString
contents'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
contents'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
contents'
        CString
etagOut' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
etagOut
        Text
etagOut'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
etagOut'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
etagOut'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
contents
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
        (ByteString, Text) -> IO (ByteString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
contents'', Text
etagOut'')
     ) (do
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
contents
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
     )

#if defined(ENABLE_OVERLOADING)
data FileLoadContentsFinishMethodInfo
instance (signature ~ (b -> m ((ByteString, T.Text))), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileLoadContentsFinishMethodInfo a signature where
    overloadedMethod = fileLoadContentsFinish

instance O.OverloadedMethodInfo FileLoadContentsFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadContentsFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadContentsFinish"
        }


#endif

-- method File::load_partial_contents_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TCArray False (-1) 3 (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a location to place the contents of the file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the length of the contents of the file,\n    or %NULL if the length is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "etag_out"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to place the current entity tag for the file,\n    or %NULL if the entity tag is not needed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText =
--                        Just
--                          "a location to place the length of the contents of the file,\n    or %NULL if the length is not needed"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_load_partial_contents_finish" g_file_load_partial_contents_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr Word8) ->                      -- contents : TCArray False (-1) 3 (TBasicType TUInt8)
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    Ptr CString ->                          -- etag_out : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous partial load operation that was started
-- with @/g_file_load_partial_contents_async()/@. The data is always
-- zero-terminated, but this is not included in the resultant /@length@/.
-- The returned /@contents@/ should be freed with 'GI.GLib.Functions.free' when no longer
-- needed.
fileLoadPartialContentsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ((ByteString, T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileLoadPartialContentsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m (ByteString, Text)
fileLoadPartialContentsFinish a
file b
res = IO (ByteString, Text) -> m (ByteString, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ByteString, Text) -> m (ByteString, Text))
-> IO (ByteString, Text) -> m (ByteString, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    Ptr (Ptr Word8)
contents <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Word8))
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr CString
etagOut <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO (ByteString, Text) -> IO () -> IO (ByteString, Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult
-> Ptr (Ptr Word8)
-> Ptr Word64
-> Ptr CString
-> Ptr (Ptr GError)
-> IO CInt
g_file_load_partial_contents_finish Ptr File
file' Ptr AsyncResult
res' Ptr (Ptr Word8)
contents Ptr Word64
length_ Ptr CString
etagOut
        Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
        Ptr Word8
contents' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
contents
        ByteString
contents'' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
contents'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
contents'
        CString
etagOut' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
etagOut
        Text
etagOut'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
etagOut'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
etagOut'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
contents
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
        (ByteString, Text) -> IO (ByteString, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
contents'', Text
etagOut'')
     ) (do
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
contents
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
etagOut
     )

#if defined(ENABLE_OVERLOADING)
data FileLoadPartialContentsFinishMethodInfo
instance (signature ~ (b -> m ((ByteString, T.Text))), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileLoadPartialContentsFinishMethodInfo a signature where
    overloadedMethod = fileLoadPartialContentsFinish

instance O.OverloadedMethodInfo FileLoadPartialContentsFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileLoadPartialContentsFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileLoadPartialContentsFinish"
        }


#endif

-- method File::make_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_make_directory" g_file_make_directory :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Creates a directory. Note that this will only create a child directory
-- of the immediate parent directory of the path or URI given by the t'GI.Gio.Interfaces.File.File'.
-- To recursively create directories, see 'GI.Gio.Interfaces.File.fileMakeDirectoryWithParents'.
-- This function will fail if the parent directory does not exist, setting
-- /@error@/ to 'GI.Gio.Enums.IOErrorEnumNotFound'. If the file system doesn\'t support
-- creating directories, this function will fail, setting /@error@/ to
-- 'GI.Gio.Enums.IOErrorEnumNotSupported'.
-- 
-- For a local t'GI.Gio.Interfaces.File.File' the newly created directory will have the default
-- (current) ownership and permissions of the current process.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileMakeDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMakeDirectory :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m ()
fileMakeDirectory a
file Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_file_make_directory Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMakeDirectoryMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMakeDirectoryMethodInfo a signature where
    overloadedMethod = fileMakeDirectory

instance O.OverloadedMethodInfo FileMakeDirectoryMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMakeDirectory",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMakeDirectory"
        }


#endif

-- method File::make_directory_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_make_directory_async" g_file_make_directory_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously creates a directory.
-- 
-- /Since: 2.38/
fileMakeDirectoryAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileMakeDirectoryAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileMakeDirectoryAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_make_directory_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileMakeDirectoryAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMakeDirectoryAsyncMethodInfo a signature where
    overloadedMethod = fileMakeDirectoryAsync

instance O.OverloadedMethodInfo FileMakeDirectoryAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMakeDirectoryAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMakeDirectoryAsync"
        }


#endif

-- method File::make_directory_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_make_directory_finish" g_file_make_directory_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous directory creation, started with
-- 'GI.Gio.Interfaces.File.fileMakeDirectoryAsync'.
-- 
-- /Since: 2.38/
fileMakeDirectoryFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMakeDirectoryFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileMakeDirectoryFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_make_directory_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMakeDirectoryFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileMakeDirectoryFinishMethodInfo a signature where
    overloadedMethod = fileMakeDirectoryFinish

instance O.OverloadedMethodInfo FileMakeDirectoryFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMakeDirectoryFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMakeDirectoryFinish"
        }


#endif

-- method File::make_directory_with_parents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_make_directory_with_parents" g_file_make_directory_with_parents :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Creates a directory and any parent directories that may not
-- exist similar to \'mkdir -p\'. If the file system does not support
-- creating directories, this function will fail, setting /@error@/ to
-- 'GI.Gio.Enums.IOErrorEnumNotSupported'. If the directory itself already exists,
-- this function will fail setting /@error@/ to 'GI.Gio.Enums.IOErrorEnumExists', unlike
-- the similar 'GI.GLib.Functions.mkdirWithParents'.
-- 
-- For a local t'GI.Gio.Interfaces.File.File' the newly created directories will have the default
-- (current) ownership and permissions of the current process.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- /Since: 2.18/
fileMakeDirectoryWithParents ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMakeDirectoryWithParents :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m ()
fileMakeDirectoryWithParents a
file Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_file_make_directory_with_parents Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMakeDirectoryWithParentsMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMakeDirectoryWithParentsMethodInfo a signature where
    overloadedMethod = fileMakeDirectoryWithParents

instance O.OverloadedMethodInfo FileMakeDirectoryWithParentsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMakeDirectoryWithParents",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMakeDirectoryWithParents"
        }


#endif

-- method File::make_symbolic_link
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GFile with the name of the symlink to create"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "symlink_value"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string with the path for the target\n    of the new symlink"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_make_symbolic_link" g_file_make_symbolic_link :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- symlink_value : TBasicType TFileName
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Creates a symbolic link named /@file@/ which contains the string
-- /@symlinkValue@/.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileMakeSymbolicLink ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File' with the name of the symlink to create
    -> [Char]
    -- ^ /@symlinkValue@/: a string with the path for the target
    --     of the new symlink
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMakeSymbolicLink :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [Char] -> Maybe b -> m ()
fileMakeSymbolicLink a
file [Char]
symlinkValue Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
symlinkValue' <- [Char] -> IO CString
stringToCString [Char]
symlinkValue
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_file_make_symbolic_link Ptr File
file' CString
symlinkValue' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
symlinkValue'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
symlinkValue'
     )

#if defined(ENABLE_OVERLOADING)
data FileMakeSymbolicLinkMethodInfo
instance (signature ~ ([Char] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMakeSymbolicLinkMethodInfo a signature where
    overloadedMethod = fileMakeSymbolicLink

instance O.OverloadedMethodInfo FileMakeSymbolicLinkMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMakeSymbolicLink",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMakeSymbolicLink"
        }


#endif

-- method File::measure_disk_usage_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , 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 "the #GAsyncResult passed to your #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "disk_usage"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of bytes of disk space used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "num_dirs"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of directories encountered"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "num_files"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the number of non-directories encountered"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_measure_disk_usage_finish" g_file_measure_disk_usage_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Word64 ->                           -- disk_usage : TBasicType TUInt64
    Ptr Word64 ->                           -- num_dirs : TBasicType TUInt64
    Ptr Word64 ->                           -- num_files : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Collects the results from an earlier call to
-- @/g_file_measure_disk_usage_async()/@.  See @/g_file_measure_disk_usage()/@ for
-- more information.
-- 
-- /Since: 2.38/
fileMeasureDiskUsageFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' passed to your t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ((Word64, Word64, Word64))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMeasureDiskUsageFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m (Word64, Word64, Word64)
fileMeasureDiskUsageFinish a
file b
result_ = IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64))
-> IO (Word64, Word64, Word64) -> m (Word64, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word64
diskUsage <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
numDirs <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word64
numFiles <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    IO (Word64, Word64, Word64) -> IO () -> IO (Word64, Word64, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult
-> Ptr Word64
-> Ptr Word64
-> Ptr Word64
-> Ptr (Ptr GError)
-> IO CInt
g_file_measure_disk_usage_finish Ptr File
file' Ptr AsyncResult
result_' Ptr Word64
diskUsage Ptr Word64
numDirs Ptr Word64
numFiles
        Word64
diskUsage' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
diskUsage
        Word64
numDirs' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
numDirs
        Word64
numFiles' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
numFiles
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
diskUsage
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
numDirs
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
numFiles
        (Word64, Word64, Word64) -> IO (Word64, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
diskUsage', Word64
numDirs', Word64
numFiles')
     ) (do
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
diskUsage
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
numDirs
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
numFiles
     )

#if defined(ENABLE_OVERLOADING)
data FileMeasureDiskUsageFinishMethodInfo
instance (signature ~ (b -> m ((Word64, Word64, Word64))), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileMeasureDiskUsageFinishMethodInfo a signature where
    overloadedMethod = fileMeasureDiskUsageFinish

instance O.OverloadedMethodInfo FileMeasureDiskUsageFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMeasureDiskUsageFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMeasureDiskUsageFinish"
        }


#endif

-- method File::monitor
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileMonitorFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileMonitorFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileMonitor" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_monitor" g_file_monitor :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileMonitorFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileMonitor.FileMonitor)

-- | Obtains a file or directory monitor for the given file,
-- depending on the type of the file.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- /Since: 2.18/
fileMonitor ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileMonitorFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileMonitorFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileMonitor.FileMonitor
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileMonitor.FileMonitor' for the given /@file@/,
    --     or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileMonitor :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileMonitorFlags] -> Maybe b -> m FileMonitor
fileMonitor a
file [FileMonitorFlags]
flags Maybe b
cancellable = IO FileMonitor -> m FileMonitor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileMonitor -> m FileMonitor)
-> IO FileMonitor -> m FileMonitor
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileMonitorFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileMonitorFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileMonitor -> IO () -> IO FileMonitor
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileMonitor
result <- (Ptr (Ptr GError) -> IO (Ptr FileMonitor)) -> IO (Ptr FileMonitor)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileMonitor))
 -> IO (Ptr FileMonitor))
-> (Ptr (Ptr GError) -> IO (Ptr FileMonitor))
-> IO (Ptr FileMonitor)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileMonitor)
g_file_monitor Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileMonitor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileMonitor" Ptr FileMonitor
result
        FileMonitor
result' <- ((ManagedPtr FileMonitor -> FileMonitor)
-> Ptr FileMonitor -> IO FileMonitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileMonitor -> FileMonitor
Gio.FileMonitor.FileMonitor) Ptr FileMonitor
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileMonitor -> IO FileMonitor
forall (m :: * -> *) a. Monad m => a -> m a
return FileMonitor
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMonitorMethodInfo
instance (signature ~ ([Gio.Flags.FileMonitorFlags] -> Maybe (b) -> m Gio.FileMonitor.FileMonitor), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMonitorMethodInfo a signature where
    overloadedMethod = fileMonitor

instance O.OverloadedMethodInfo FileMonitorMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMonitor",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMonitor"
        }


#endif

-- method File::monitor_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileMonitorFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileMonitorFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileMonitor" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_monitor_directory" g_file_monitor_directory :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileMonitorFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileMonitor.FileMonitor)

-- | Obtains a directory monitor for the given file.
-- This may fail if directory monitoring is not supported.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- It does not make sense for /@flags@/ to contain
-- 'GI.Gio.Flags.FileMonitorFlagsWatchHardLinks', since hard links can not be made to
-- directories.  It is not possible to monitor all the files in a
-- directory for changes made via hard links; if you want to do this then
-- you must register individual watches with 'GI.Gio.Interfaces.File.fileMonitor'.
fileMonitorDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileMonitorFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileMonitorFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileMonitor.FileMonitor
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileMonitor.FileMonitor' for the given /@file@/,
    --     or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileMonitorDirectory :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileMonitorFlags] -> Maybe b -> m FileMonitor
fileMonitorDirectory a
file [FileMonitorFlags]
flags Maybe b
cancellable = IO FileMonitor -> m FileMonitor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileMonitor -> m FileMonitor)
-> IO FileMonitor -> m FileMonitor
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileMonitorFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileMonitorFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileMonitor -> IO () -> IO FileMonitor
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileMonitor
result <- (Ptr (Ptr GError) -> IO (Ptr FileMonitor)) -> IO (Ptr FileMonitor)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileMonitor))
 -> IO (Ptr FileMonitor))
-> (Ptr (Ptr GError) -> IO (Ptr FileMonitor))
-> IO (Ptr FileMonitor)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileMonitor)
g_file_monitor_directory Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileMonitor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileMonitorDirectory" Ptr FileMonitor
result
        FileMonitor
result' <- ((ManagedPtr FileMonitor -> FileMonitor)
-> Ptr FileMonitor -> IO FileMonitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileMonitor -> FileMonitor
Gio.FileMonitor.FileMonitor) Ptr FileMonitor
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileMonitor -> IO FileMonitor
forall (m :: * -> *) a. Monad m => a -> m a
return FileMonitor
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMonitorDirectoryMethodInfo
instance (signature ~ ([Gio.Flags.FileMonitorFlags] -> Maybe (b) -> m Gio.FileMonitor.FileMonitor), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMonitorDirectoryMethodInfo a signature where
    overloadedMethod = fileMonitorDirectory

instance O.OverloadedMethodInfo FileMonitorDirectoryMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMonitorDirectory",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMonitorDirectory"
        }


#endif

-- method File::monitor_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileMonitorFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileMonitorFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileMonitor" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_monitor_file" g_file_monitor_file :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileMonitorFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileMonitor.FileMonitor)

-- | Obtains a file monitor for the given file. If no file notification
-- mechanism exists, then regular polling of the file is used.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- If /@flags@/ contains 'GI.Gio.Flags.FileMonitorFlagsWatchHardLinks' then the monitor
-- will also attempt to report changes made to the file via another
-- filename (ie, a hard link). Without this flag, you can only rely on
-- changes made through the filename contained in /@file@/ to be
-- reported. Using this flag may result in an increase in resource
-- usage, and may not have any effect depending on the t'GI.Gio.Objects.FileMonitor.FileMonitor'
-- backend and\/or filesystem type.
fileMonitorFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileMonitorFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileMonitorFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileMonitor.FileMonitor
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileMonitor.FileMonitor' for the given /@file@/,
    --     or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileMonitorFile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileMonitorFlags] -> Maybe b -> m FileMonitor
fileMonitorFile a
file [FileMonitorFlags]
flags Maybe b
cancellable = IO FileMonitor -> m FileMonitor
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileMonitor -> m FileMonitor)
-> IO FileMonitor -> m FileMonitor
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileMonitorFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileMonitorFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileMonitor -> IO () -> IO FileMonitor
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileMonitor
result <- (Ptr (Ptr GError) -> IO (Ptr FileMonitor)) -> IO (Ptr FileMonitor)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileMonitor))
 -> IO (Ptr FileMonitor))
-> (Ptr (Ptr GError) -> IO (Ptr FileMonitor))
-> IO (Ptr FileMonitor)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileMonitor)
g_file_monitor_file Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileMonitor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileMonitorFile" Ptr FileMonitor
result
        FileMonitor
result' <- ((ManagedPtr FileMonitor -> FileMonitor)
-> Ptr FileMonitor -> IO FileMonitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileMonitor -> FileMonitor
Gio.FileMonitor.FileMonitor) Ptr FileMonitor
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileMonitor -> IO FileMonitor
forall (m :: * -> *) a. Monad m => a -> m a
return FileMonitor
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMonitorFileMethodInfo
instance (signature ~ ([Gio.Flags.FileMonitorFlags] -> Maybe (b) -> m Gio.FileMonitor.FileMonitor), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileMonitorFileMethodInfo a signature where
    overloadedMethod = fileMonitorFile

instance O.OverloadedMethodInfo FileMonitorFileMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMonitorFile",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMonitorFile"
        }


#endif

-- method File::mount_enclosing_volume
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "location"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountMountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation\n    or %NULL to avoid user interaction"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_mount_enclosing_volume" g_file_mount_enclosing_volume :: 
    Ptr File ->                             -- location : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountMountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    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 ()

-- | Starts a /@mountOperation@/, mounting the volume that contains
-- the file /@location@/.
-- 
-- When this operation has completed, /@callback@/ will be called with
-- /@userUser@/ data, and the operation can be finalized with
-- 'GI.Gio.Interfaces.File.fileMountEnclosingVolumeFinish'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileMountEnclosingVolume ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@location@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountMountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation'
    --     or 'P.Nothing' to avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileMountEnclosingVolume :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountMountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileMountEnclosingVolume a
location [MountMountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
location' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
location
    let flags' :: CUInt
flags' = [MountMountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountMountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_mount_enclosing_volume Ptr File
location' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
location
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileMountEnclosingVolumeMethodInfo
instance (signature ~ ([Gio.Flags.MountMountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileMountEnclosingVolumeMethodInfo a signature where
    overloadedMethod = fileMountEnclosingVolume

instance O.OverloadedMethodInfo FileMountEnclosingVolumeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMountEnclosingVolume",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMountEnclosingVolume"
        }


#endif

-- method File::mount_enclosing_volume_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "location"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_mount_enclosing_volume_finish" g_file_mount_enclosing_volume_finish :: 
    Ptr File ->                             -- location : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a mount operation started by 'GI.Gio.Interfaces.File.fileMountEnclosingVolume'.
fileMountEnclosingVolumeFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@location@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMountEnclosingVolumeFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileMountEnclosingVolumeFinish a
location b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
location' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
location
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_mount_enclosing_volume_finish Ptr File
location' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
location
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMountEnclosingVolumeFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileMountEnclosingVolumeFinishMethodInfo a signature where
    overloadedMethod = fileMountEnclosingVolumeFinish

instance O.OverloadedMethodInfo FileMountEnclosingVolumeFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMountEnclosingVolumeFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMountEnclosingVolumeFinish"
        }


#endif

-- method File::mount_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountMountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation,\n    or %NULL to avoid user interaction"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_mount_mountable" g_file_mount_mountable :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountMountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    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 ()

-- | Mounts a file of type G_FILE_TYPE_MOUNTABLE.
-- Using /@mountOperation@/, you can request callbacks when, for instance,
-- passwords are needed during authentication.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileMountMountableFinish' to get
-- the result of the operation.
fileMountMountable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountMountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation',
    --     or 'P.Nothing' to avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileMountMountable :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountMountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileMountMountable a
file [MountMountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [MountMountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountMountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_mount_mountable Ptr File
file' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileMountMountableMethodInfo
instance (signature ~ ([Gio.Flags.MountMountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileMountMountableMethodInfo a signature where
    overloadedMethod = fileMountMountable

instance O.OverloadedMethodInfo FileMountMountableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMountMountable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMountMountable"
        }


#endif

-- method File::mount_mountable_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "g_file_mount_mountable_finish" g_file_mount_mountable_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr File)

-- | Finishes a mount operation. See 'GI.Gio.Interfaces.File.fileMountMountable' for details.
-- 
-- Finish an asynchronous mount operation that was started
-- with 'GI.Gio.Interfaces.File.fileMountMountable'.
fileMountMountableFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileMountMountableFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m File
fileMountMountableFinish a
file b
result_ = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO File -> IO () -> IO 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 File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr File)
g_file_mount_mountable_finish Ptr File
file' Ptr AsyncResult
result_'
        Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileMountMountableFinish" Ptr File
result
        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
File) Ptr File
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMountMountableFinishMethodInfo
instance (signature ~ (b -> m File), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileMountMountableFinishMethodInfo a signature where
    overloadedMethod = fileMountMountableFinish

instance O.OverloadedMethodInfo FileMountMountableFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMountMountableFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMountMountableFinish"
        }


#endif

-- method File::move
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "source"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFile pointing to the source location"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destination"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFile pointing to the destination location"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCopyFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "set of #GFileCopyFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Gio" , name = "FileProgressCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "#GFileProgressCallback\n    function for updates"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress_callback_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "gpointer to user data for\n    the callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_move" g_file_move :: 
    Ptr File ->                             -- source : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr File ->                             -- destination : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCopyFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_FileProgressCallback -> -- progress_callback : TInterface (Name {namespace = "Gio", name = "FileProgressCallback"})
    Ptr () ->                               -- progress_callback_data : TBasicType TPtr
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to move the file or directory /@source@/ to the location specified
-- by /@destination@/. If native move operations are supported then this is
-- used, otherwise a copy + delete fallback is used. The native
-- implementation may support moving directories (for instance on moves
-- inside the same filesystem), but the fallback code does not.
-- 
-- If the flag @/G_FILE_COPY_OVERWRITE/@ is specified an already
-- existing /@destination@/ file is overwritten.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- If /@progressCallback@/ is not 'P.Nothing', then the operation can be monitored
-- by setting this to a t'GI.Gio.Callbacks.FileProgressCallback' function.
-- /@progressCallbackData@/ will be passed to this function. It is
-- guaranteed that this callback will be called after all data has been
-- transferred with the total number of bytes copied during the operation.
-- 
-- If the /@source@/ file does not exist, then the 'GI.Gio.Enums.IOErrorEnumNotFound'
-- error is returned, independent on the status of the /@destination@/.
-- 
-- If @/G_FILE_COPY_OVERWRITE/@ is not specified and the target exists,
-- then the error 'GI.Gio.Enums.IOErrorEnumExists' is returned.
-- 
-- If trying to overwrite a file over a directory, the 'GI.Gio.Enums.IOErrorEnumIsDirectory'
-- error is returned. If trying to overwrite a directory with a directory the
-- 'GI.Gio.Enums.IOErrorEnumWouldMerge' error is returned.
-- 
-- If the source is a directory and the target does not exist, or
-- @/G_FILE_COPY_OVERWRITE/@ is specified and the target is a file, then
-- the 'GI.Gio.Enums.IOErrorEnumWouldRecurse' error may be returned (if the native
-- move operation isn\'t available).
fileMove ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@source@/: t'GI.Gio.Interfaces.File.File' pointing to the source location
    -> b
    -- ^ /@destination@/: t'GI.Gio.Interfaces.File.File' pointing to the destination location
    -> [Gio.Flags.FileCopyFlags]
    -- ^ /@flags@/: set of t'GI.Gio.Flags.FileCopyFlags'
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.FileProgressCallback)
    -- ^ /@progressCallback@/: t'GI.Gio.Callbacks.FileProgressCallback'
    --     function for updates
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileMove :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsFile b, IsCancellable c) =>
a
-> b
-> [FileCopyFlags]
-> Maybe c
-> Maybe FileProgressCallback
-> m ()
fileMove a
source b
destination [FileCopyFlags]
flags Maybe c
cancellable Maybe FileProgressCallback
progressCallback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
source' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
source
    Ptr File
destination' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
destination
    let flags' :: CUInt
flags' = [FileCopyFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCopyFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_FileProgressCallback
maybeProgressCallback <- case Maybe FileProgressCallback
progressCallback of
        Maybe FileProgressCallback
Nothing -> FunPtr C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_FileProgressCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just FileProgressCallback
jProgressCallback -> do
            FunPtr C_FileProgressCallback
jProgressCallback' <- C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
Gio.Callbacks.mk_FileProgressCallback (Maybe (Ptr (FunPtr C_FileProgressCallback))
-> C_FileProgressCallback -> C_FileProgressCallback
Gio.Callbacks.wrap_FileProgressCallback Maybe (Ptr (FunPtr C_FileProgressCallback))
forall a. Maybe a
Nothing (FileProgressCallback -> C_FileProgressCallback
Gio.Callbacks.drop_closures_FileProgressCallback FileProgressCallback
jProgressCallback))
            FunPtr C_FileProgressCallback -> IO (FunPtr C_FileProgressCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_FileProgressCallback
jProgressCallback'
    let progressCallbackData :: Ptr a
progressCallbackData = Ptr a
forall a. Ptr a
nullPtr
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr File
-> CUInt
-> Ptr Cancellable
-> FunPtr C_FileProgressCallback
-> Ptr ()
-> Ptr (Ptr GError)
-> IO CInt
g_file_move Ptr File
source' Ptr File
destination' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_FileProgressCallback
maybeProgressCallback Ptr ()
forall a. Ptr a
progressCallbackData
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_FileProgressCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FileProgressCallback
maybeProgressCallback
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
source
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
destination
        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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_FileProgressCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_FileProgressCallback
maybeProgressCallback
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileMoveMethodInfo
instance (signature ~ (b -> [Gio.Flags.FileCopyFlags] -> Maybe (c) -> Maybe (Gio.Callbacks.FileProgressCallback) -> m ()), MonadIO m, IsFile a, IsFile b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileMoveMethodInfo a signature where
    overloadedMethod = fileMove

instance O.OverloadedMethodInfo FileMoveMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileMove",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileMove"
        }


#endif

-- method File::open_readwrite
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFile to open" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileIOStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_open_readwrite" g_file_open_readwrite :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileIOStream.FileIOStream)

-- | Opens an existing file for reading and writing. The result is
-- a t'GI.Gio.Objects.FileIOStream.FileIOStream' that can be used to read and write the contents
-- of the file.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- If the file does not exist, the 'GI.Gio.Enums.IOErrorEnumNotFound' error will
-- be returned. If the file is a directory, the 'GI.Gio.Enums.IOErrorEnumIsDirectory'
-- error will be returned. Other errors are possible too, and depend on
-- what kind of filesystem the file is on. Note that in many non-local
-- file cases read and write streams are not supported, so make sure you
-- really need to do read and write streaming, rather than just opening
-- for reading or writing.
-- 
-- /Since: 2.22/
fileOpenReadwrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: t'GI.Gio.Interfaces.File.File' to open
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m Gio.FileIOStream.FileIOStream
    -- ^ __Returns:__ t'GI.Gio.Objects.FileIOStream.FileIOStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileOpenReadwrite :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m FileIOStream
fileOpenReadwrite a
file Maybe b
cancellable = IO FileIOStream -> m FileIOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileIOStream -> m FileIOStream)
-> IO FileIOStream -> m FileIOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileIOStream -> IO () -> IO FileIOStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileIOStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileIOStream))
 -> IO (Ptr FileIOStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr FileIOStream)
g_file_open_readwrite Ptr File
file' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileIOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileOpenReadwrite" Ptr FileIOStream
result
        FileIOStream
result' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileIOStream -> IO FileIOStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileIOStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileOpenReadwriteMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.FileIOStream.FileIOStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileOpenReadwriteMethodInfo a signature where
    overloadedMethod = fileOpenReadwrite

instance O.OverloadedMethodInfo FileOpenReadwriteMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileOpenReadwrite",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileOpenReadwrite"
        }


#endif

-- method File::open_readwrite_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_open_readwrite_async" g_file_open_readwrite_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously opens /@file@/ for reading and writing.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileOpenReadwrite' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileOpenReadwriteFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
fileOpenReadwriteAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileOpenReadwriteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileOpenReadwriteAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_open_readwrite_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileOpenReadwriteAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileOpenReadwriteAsyncMethodInfo a signature where
    overloadedMethod = fileOpenReadwriteAsync

instance O.OverloadedMethodInfo FileOpenReadwriteAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileOpenReadwriteAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileOpenReadwriteAsync"
        }


#endif

-- method File::open_readwrite_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileIOStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_open_readwrite_finish" g_file_open_readwrite_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileIOStream.FileIOStream)

-- | Finishes an asynchronous file read operation started with
-- 'GI.Gio.Interfaces.File.fileOpenReadwriteAsync'.
-- 
-- /Since: 2.22/
fileOpenReadwriteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileIOStream.FileIOStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileIOStream.FileIOStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileOpenReadwriteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileIOStream
fileOpenReadwriteFinish a
file b
res = IO FileIOStream -> m FileIOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileIOStream -> m FileIOStream)
-> IO FileIOStream -> m FileIOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileIOStream -> IO () -> IO FileIOStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileIOStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileIOStream))
 -> IO (Ptr FileIOStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileIOStream)
g_file_open_readwrite_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileIOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileOpenReadwriteFinish" Ptr FileIOStream
result
        FileIOStream
result' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileIOStream -> IO FileIOStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileIOStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileOpenReadwriteFinishMethodInfo
instance (signature ~ (b -> m Gio.FileIOStream.FileIOStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileOpenReadwriteFinishMethodInfo a signature where
    overloadedMethod = fileOpenReadwriteFinish

instance O.OverloadedMethodInfo FileOpenReadwriteFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileOpenReadwriteFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileOpenReadwriteFinish"
        }


#endif

-- method File::peek_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_file_peek_path" g_file_peek_path :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CString

-- | Exactly like 'GI.Gio.Interfaces.File.fileGetPath', but caches the result via
-- @/g_object_set_qdata_full()/@.  This is useful for example in C
-- applications which mix @g_file_*@ APIs with native ones.  It
-- also avoids an extra duplicated string when possible, so will be
-- generally more efficient.
-- 
-- This call does no blocking I\/O.
-- 
-- /Since: 2.56/
filePeekPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> m (Maybe [Char])
    -- ^ __Returns:__ string containing the t'GI.Gio.Interfaces.File.File'\'s path,
    --     or 'P.Nothing' if no such path exists. The returned string is owned by /@file@/.
filePeekPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m (Maybe [Char])
filePeekPath a
file = IO (Maybe [Char]) -> m (Maybe [Char])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Char]) -> m (Maybe [Char]))
-> IO (Maybe [Char]) -> m (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
result <- Ptr File -> IO CString
g_file_peek_path Ptr File
file'
    Maybe [Char]
maybeResult <- CString -> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO [Char]) -> IO (Maybe [Char]))
-> (CString -> IO [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        [Char]
result'' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result'
        [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
maybeResult

#if defined(ENABLE_OVERLOADING)
data FilePeekPathMethodInfo
instance (signature ~ (m (Maybe [Char])), MonadIO m, IsFile a) => O.OverloadedMethod FilePeekPathMethodInfo a signature where
    overloadedMethod = filePeekPath

instance O.OverloadedMethodInfo FilePeekPathMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.filePeekPath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:filePeekPath"
        }


#endif

-- method File::poll_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object, %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_poll_mountable" g_file_poll_mountable :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    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 ()

-- | Polls a file of type @/G_FILE_TYPE_MOUNTABLE/@.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileMountMountableFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
filePollMountable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
filePollMountable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
filePollMountable a
file Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_poll_mountable Ptr File
file' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FilePollMountableMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FilePollMountableMethodInfo a signature where
    overloadedMethod = filePollMountable

instance O.OverloadedMethodInfo FilePollMountableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.filePollMountable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:filePollMountable"
        }


#endif

-- method File::poll_mountable_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_poll_mountable_finish" g_file_poll_mountable_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a poll operation. See 'GI.Gio.Interfaces.File.filePollMountable' for details.
-- 
-- Finish an asynchronous poll operation that was polled
-- with 'GI.Gio.Interfaces.File.filePollMountable'.
-- 
-- /Since: 2.22/
filePollMountableFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
filePollMountableFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
filePollMountableFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_poll_mountable_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FilePollMountableFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FilePollMountableFinishMethodInfo a signature where
    overloadedMethod = filePollMountableFinish

instance O.OverloadedMethodInfo FilePollMountableFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.filePollMountableFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:filePollMountableFinish"
        }


#endif

-- method File::query_default_handler
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile to open" , 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 "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "AppInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_default_handler" g_file_query_default_handler :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.AppInfo.AppInfo)

-- | Returns the t'GI.Gio.Interfaces.AppInfo.AppInfo' that is registered as the default
-- application to handle the file specified by /@file@/.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileQueryDefaultHandler ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File' to open
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m Gio.AppInfo.AppInfo
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.AppInfo.AppInfo' if the handle was found,
    --     'P.Nothing' if there were errors.
    --     When you are done with it, release it with 'GI.GObject.Objects.Object.objectUnref' /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryDefaultHandler :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m AppInfo
fileQueryDefaultHandler a
file Maybe b
cancellable = IO AppInfo -> m AppInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppInfo -> m AppInfo) -> IO AppInfo -> m AppInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO AppInfo -> IO () -> IO AppInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr AppInfo
result <- (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo))
-> (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr AppInfo)
g_file_query_default_handler Ptr File
file' Ptr Cancellable
maybeCancellable
        Text -> Ptr AppInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryDefaultHandler" Ptr AppInfo
result
        AppInfo
result' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
Gio.AppInfo.AppInfo) Ptr AppInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryDefaultHandlerMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.AppInfo.AppInfo), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryDefaultHandlerMethodInfo a signature where
    overloadedMethod = fileQueryDefaultHandler

instance O.OverloadedMethodInfo FileQueryDefaultHandlerMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryDefaultHandler",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryDefaultHandler"
        }


#endif

-- method File::query_default_handler_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile to open" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object, %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the request is done"
--                 , 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 "g_file_query_default_handler_async" g_file_query_default_handler_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Async version of 'GI.Gio.Interfaces.File.fileQueryDefaultHandler'.
-- 
-- /Since: 2.60/
fileQueryDefaultHandlerAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File' to open
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is done
    -> m ()
fileQueryDefaultHandlerAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileQueryDefaultHandlerAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_query_default_handler_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileQueryDefaultHandlerAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryDefaultHandlerAsyncMethodInfo a signature where
    overloadedMethod = fileQueryDefaultHandlerAsync

instance O.OverloadedMethodInfo FileQueryDefaultHandlerAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryDefaultHandlerAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryDefaultHandlerAsync"
        }


#endif

-- method File::query_default_handler_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile to open" , 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 = "AppInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_default_handler_finish" g_file_query_default_handler_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.AppInfo.AppInfo)

-- | Finishes a 'GI.Gio.Interfaces.File.fileQueryDefaultHandlerAsync' operation.
-- 
-- /Since: 2.60/
fileQueryDefaultHandlerFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File' to open
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.AppInfo.AppInfo
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.AppInfo.AppInfo' if the handle was found,
    --     'P.Nothing' if there were errors.
    --     When you are done with it, release it with 'GI.GObject.Objects.Object.objectUnref' /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryDefaultHandlerFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m AppInfo
fileQueryDefaultHandlerFinish a
file b
result_ = IO AppInfo -> m AppInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppInfo -> m AppInfo) -> IO AppInfo -> m AppInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO AppInfo -> IO () -> IO AppInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr AppInfo
result <- (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo))
-> (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr AppInfo)
g_file_query_default_handler_finish Ptr File
file' Ptr AsyncResult
result_'
        Text -> Ptr AppInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryDefaultHandlerFinish" Ptr AppInfo
result
        AppInfo
result' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
Gio.AppInfo.AppInfo) Ptr AppInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryDefaultHandlerFinishMethodInfo
instance (signature ~ (b -> m Gio.AppInfo.AppInfo), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileQueryDefaultHandlerFinishMethodInfo a signature where
    overloadedMethod = fileQueryDefaultHandlerFinish

instance O.OverloadedMethodInfo FileQueryDefaultHandlerFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryDefaultHandlerFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryDefaultHandlerFinish"
        }


#endif

-- method File::query_exists
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 "g_file_query_exists" g_file_query_exists :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    IO CInt

-- | Utility function to check if a particular file exists. This is
-- implemented using 'GI.Gio.Interfaces.File.fileQueryInfo' and as such does blocking I\/O.
-- 
-- Note that in many cases it is <https://en.wikipedia.org/wiki/Time_of_check_to_time_of_use racy to first check for file existence>
-- and then execute something based on the outcome of that, because the
-- file might have been created or removed in between the operations. The
-- general approach to handling that is to not check, but just do the
-- operation and handle the errors as they come.
-- 
-- As an example of race-free checking, take the case of reading a file,
-- and if it doesn\'t exist, creating it. There are two racy versions: read
-- it, and on error create it; and: check if it exists, if not create it.
-- These can both result in two processes creating the file (with perhaps
-- a partially written file as the result). The correct approach is to
-- always try to create the file with 'GI.Gio.Interfaces.File.fileCreate' which will either
-- atomically create the file or fail with a 'GI.Gio.Enums.IOErrorEnumExists' error.
-- 
-- However, in many cases an existence check is useful in a user interface,
-- for instance to make a menu item sensitive\/insensitive, so that you don\'t
-- have to fool users that something is possible and then just show an error
-- dialog. If you do this, you should make sure to also handle the errors
-- that can happen due to races when you execute the operation.
fileQueryExists ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the file exists (and can be detected without error),
    --     'P.False' otherwise (or if cancelled).
fileQueryExists :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m Bool
fileQueryExists a
file Maybe b
cancellable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    CInt
result <- Ptr File -> Ptr Cancellable -> IO CInt
g_file_query_exists Ptr File
file' Ptr Cancellable
maybeCancellable
    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
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileQueryExistsMethodInfo
instance (signature ~ (Maybe (b) -> m Bool), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryExistsMethodInfo a signature where
    overloadedMethod = fileQueryExists

instance O.OverloadedMethodInfo FileQueryExistsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryExists",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryExists"
        }


#endif

-- method File::query_file_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a set of #GFileQueryInfoFlags passed to g_file_query_info()"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileType" })
-- throws : False
-- Skip return : False

foreign import ccall "g_file_query_file_type" g_file_query_file_type :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    IO CUInt

-- | Utility function to inspect the t'GI.Gio.Enums.FileType' of a file. This is
-- implemented using 'GI.Gio.Interfaces.File.fileQueryInfo' and as such does blocking I\/O.
-- 
-- The primary use case of this method is to check if a file is
-- a regular file, directory, or symlink.
-- 
-- /Since: 2.18/
fileQueryFileType ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileQueryInfoFlags' passed to 'GI.Gio.Interfaces.File.fileQueryInfo'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.Enums.FileType
    -- ^ __Returns:__ The t'GI.Gio.Enums.FileType' of the file and @/G_FILE_TYPE_UNKNOWN/@
    --     if the file does not exist
fileQueryFileType :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> [FileQueryInfoFlags] -> Maybe b -> m FileType
fileQueryFileType a
file [FileQueryInfoFlags]
flags Maybe b
cancellable = IO FileType -> m FileType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileType -> m FileType) -> IO FileType -> m FileType
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    CUInt
result <- Ptr File -> CUInt -> Ptr Cancellable -> IO CUInt
g_file_query_file_type Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable
    let result' :: FileType
result' = (Int -> FileType
forall a. Enum a => Int -> a
toEnum (Int -> FileType) -> (CUInt -> Int) -> CUInt -> FileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    FileType -> IO FileType
forall (m :: * -> *) a. Monad m => a -> m a
return FileType
result'

#if defined(ENABLE_OVERLOADING)
data FileQueryFileTypeMethodInfo
instance (signature ~ ([Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m Gio.Enums.FileType), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryFileTypeMethodInfo a signature where
    overloadedMethod = fileQueryFileType

instance O.OverloadedMethodInfo FileQueryFileTypeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryFileType",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryFileType"
        }


#endif

-- method File::query_filesystem_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an attribute query string"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_filesystem_info" g_file_query_filesystem_info :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attributes : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Similar to 'GI.Gio.Interfaces.File.fileQueryInfo', but obtains information
-- about the filesystem the /@file@/ is on, rather than the file itself.
-- For instance the amount of space available and the type of
-- the filesystem.
-- 
-- The /@attributes@/ value is a string that specifies the attributes
-- that should be gathered. It is not an error if it\'s not possible
-- to read a particular requested attribute from a file - it just
-- won\'t be set. /@attributes@/ should be a comma-separated list of
-- attributes or attribute wildcards. The wildcard \"*\" means all
-- attributes, and a wildcard like \"filesystem::*\" means all attributes
-- in the filesystem namespace. The standard namespace for filesystem
-- attributes is \"filesystem\". Common attributes of interest are
-- 'GI.Gio.Constants.FILE_ATTRIBUTE_FILESYSTEM_SIZE' (the total size of the filesystem
-- in bytes), 'GI.Gio.Constants.FILE_ATTRIBUTE_FILESYSTEM_FREE' (number of bytes available),
-- and 'GI.Gio.Constants.FILE_ATTRIBUTE_FILESYSTEM_TYPE' (type of the filesystem).
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- If the file does not exist, the 'GI.Gio.Enums.IOErrorEnumNotFound' error will
-- be returned. Other errors are possible too, and depend on what
-- kind of filesystem the file is on.
fileQueryFilesystemInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attributes@/: an attribute query string
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileInfo.FileInfo
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileInfo.FileInfo' or 'P.Nothing' if there was an error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryFilesystemInfo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Maybe b -> m FileInfo
fileQueryFilesystemInfo a
file Text
attributes Maybe b
cancellable = IO FileInfo -> m FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInfo
result <- (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo))
-> (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileInfo)
g_file_query_filesystem_info Ptr File
file' CString
attributes' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryFilesystemInfo" Ptr FileInfo
result
        FileInfo
result' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
        FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryFilesystemInfoMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m Gio.FileInfo.FileInfo), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryFilesystemInfoMethodInfo a signature where
    overloadedMethod = fileQueryFilesystemInfo

instance O.OverloadedMethodInfo FileQueryFilesystemInfoMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryFilesystemInfo",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryFilesystemInfo"
        }


#endif

-- method File::query_filesystem_info_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an attribute query string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_query_filesystem_info_async" g_file_query_filesystem_info_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attributes : TBasicType TUTF8
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously gets the requested information about the filesystem
-- that the specified /@file@/ is on. The result is a t'GI.Gio.Objects.FileInfo.FileInfo' object
-- that contains key-value attributes (such as type or size for the
-- file).
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileQueryFilesystemInfo' which is the
-- synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called. You can
-- then call 'GI.Gio.Interfaces.File.fileQueryInfoFinish' to get the result of the
-- operation.
fileQueryFilesystemInfoAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attributes@/: an attribute query string
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileQueryFilesystemInfoAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileQueryFilesystemInfoAsync a
file Text
attributes Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_query_filesystem_info_async Ptr File
file' CString
attributes' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileQueryFilesystemInfoAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryFilesystemInfoAsyncMethodInfo a signature where
    overloadedMethod = fileQueryFilesystemInfoAsync

instance O.OverloadedMethodInfo FileQueryFilesystemInfoAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryFilesystemInfoAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryFilesystemInfoAsync"
        }


#endif

-- method File::query_filesystem_info_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_filesystem_info_finish" g_file_query_filesystem_info_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Finishes an asynchronous filesystem info query.
-- See 'GI.Gio.Interfaces.File.fileQueryFilesystemInfoAsync'.
fileQueryFilesystemInfoFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileInfo.FileInfo
    -- ^ __Returns:__ t'GI.Gio.Objects.FileInfo.FileInfo' for given /@file@/
    --     or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryFilesystemInfoFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileInfo
fileQueryFilesystemInfoFinish a
file b
res = IO FileInfo -> m FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInfo
result <- (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo))
-> (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileInfo)
g_file_query_filesystem_info_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryFilesystemInfoFinish" Ptr FileInfo
result
        FileInfo
result' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryFilesystemInfoFinishMethodInfo
instance (signature ~ (b -> m Gio.FileInfo.FileInfo), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileQueryFilesystemInfoFinishMethodInfo a signature where
    overloadedMethod = fileQueryFilesystemInfoFinish

instance O.OverloadedMethodInfo FileQueryFilesystemInfoFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryFilesystemInfoFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryFilesystemInfoFinish"
        }


#endif

-- method File::query_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an attribute query string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "FileInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_info" g_file_query_info :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attributes : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Gets the requested information about specified /@file@/.
-- The result is a t'GI.Gio.Objects.FileInfo.FileInfo' object that contains key-value
-- attributes (such as the type or size of the file).
-- 
-- The /@attributes@/ value is a string that specifies the file
-- attributes that should be gathered. It is not an error if
-- it\'s not possible to read a particular requested attribute
-- from a file - it just won\'t be set. /@attributes@/ should be a
-- comma-separated list of attributes or attribute wildcards.
-- The wildcard \"*\" means all attributes, and a wildcard like
-- \"standard::*\" means all attributes in the standard namespace.
-- An example attribute query be \"standard::*,owner[user](#g:signal:user)\".
-- The standard attributes are available as defines, like
-- 'GI.Gio.Constants.FILE_ATTRIBUTE_STANDARD_NAME'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- For symlinks, normally the information about the target of the
-- symlink is returned, rather than information about the symlink
-- itself. However if you pass @/G_FILE_QUERY_INFO_NOFOLLOW_SYMLINKS/@
-- in /@flags@/ the information about the symlink itself will be returned.
-- Also, for symlinks that point to non-existing files the information
-- about the symlink itself will be returned.
-- 
-- If the file does not exist, the 'GI.Gio.Enums.IOErrorEnumNotFound' error will be
-- returned. Other errors are possible too, and depend on what kind of
-- filesystem the file is on.
fileQueryInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attributes@/: an attribute query string
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileInfo.FileInfo
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileInfo.FileInfo' for the given /@file@/, or 'P.Nothing'
    --     on error. Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryInfo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> [FileQueryInfoFlags] -> Maybe b -> m FileInfo
fileQueryInfo a
file Text
attributes [FileQueryInfoFlags]
flags Maybe b
cancellable = IO FileInfo -> m FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInfo
result <- (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo))
-> (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileInfo)
g_file_query_info Ptr File
file' CString
attributes' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryInfo" Ptr FileInfo
result
        FileInfo
result' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
        FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryInfoMethodInfo
instance (signature ~ (T.Text -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m Gio.FileInfo.FileInfo), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryInfoMethodInfo a signature where
    overloadedMethod = fileQueryInfo

instance O.OverloadedMethodInfo FileQueryInfoMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryInfo",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryInfo"
        }


#endif

-- method File::query_info_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attributes"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an attribute query string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileQueryInfoFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the\n    request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_query_info_async" g_file_query_info_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attributes : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously gets the requested information about specified /@file@/.
-- The result is a t'GI.Gio.Objects.FileInfo.FileInfo' object that contains key-value attributes
-- (such as type or size for the file).
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileQueryInfo' which is the synchronous
-- version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called. You can
-- then call 'GI.Gio.Interfaces.File.fileQueryInfoFinish' to get the result of the operation.
fileQueryInfoAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attributes@/: an attribute query string
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the
    --     request is satisfied
    -> m ()
fileQueryInfoAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Text
-> [FileQueryInfoFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileQueryInfoAsync a
file Text
attributes [FileQueryInfoFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attributes' <- Text -> IO CString
textToCString Text
attributes
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CString
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_query_info_async Ptr File
file' CString
attributes' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attributes'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileQueryInfoAsyncMethodInfo
instance (signature ~ (T.Text -> [Gio.Flags.FileQueryInfoFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryInfoAsyncMethodInfo a signature where
    overloadedMethod = fileQueryInfoAsync

instance O.OverloadedMethodInfo FileQueryInfoAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryInfoAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryInfoAsync"
        }


#endif

-- method File::query_info_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_info_finish" g_file_query_info_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInfo.FileInfo)

-- | Finishes an asynchronous file info query.
-- See 'GI.Gio.Interfaces.File.fileQueryInfoAsync'.
fileQueryInfoFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileInfo.FileInfo
    -- ^ __Returns:__ t'GI.Gio.Objects.FileInfo.FileInfo' for given /@file@/
    --     or 'P.Nothing' on error. Free the returned object with
    --     'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryInfoFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileInfo
fileQueryInfoFinish a
file b
res = IO FileInfo -> m FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInfo
result <- (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo))
-> (Ptr (Ptr GError) -> IO (Ptr FileInfo)) -> IO (Ptr FileInfo)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileInfo)
g_file_query_info_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryInfoFinish" Ptr FileInfo
result
        FileInfo
result' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryInfoFinishMethodInfo
instance (signature ~ (b -> m Gio.FileInfo.FileInfo), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileQueryInfoFinishMethodInfo a signature where
    overloadedMethod = fileQueryInfoFinish

instance O.OverloadedMethodInfo FileQueryInfoFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryInfoFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryInfoFinish"
        }


#endif

-- method File::query_settable_attributes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "FileAttributeInfoList" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_settable_attributes" g_file_query_settable_attributes :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileAttributeInfoList.FileAttributeInfoList)

-- | Obtain the list of settable attributes for the file.
-- 
-- Returns the type and full attribute name of all the attributes
-- that can be set on this file. This doesn\'t mean setting it will
-- always succeed though, you might get an access failure, or some
-- specific file may not support a specific attribute.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileQuerySettableAttributes ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileAttributeInfoList.FileAttributeInfoList
    -- ^ __Returns:__ a t'GI.Gio.Structs.FileAttributeInfoList.FileAttributeInfoList' describing the settable attributes.
    --     When you are done with it, release it with
    --     'GI.Gio.Structs.FileAttributeInfoList.fileAttributeInfoListUnref' /(Can throw 'Data.GI.Base.GError.GError')/
fileQuerySettableAttributes :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m FileAttributeInfoList
fileQuerySettableAttributes a
file Maybe b
cancellable = IO FileAttributeInfoList -> m FileAttributeInfoList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileAttributeInfoList -> m FileAttributeInfoList)
-> IO FileAttributeInfoList -> m FileAttributeInfoList
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileAttributeInfoList -> IO () -> IO FileAttributeInfoList
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileAttributeInfoList
result <- (Ptr (Ptr GError) -> IO (Ptr FileAttributeInfoList))
-> IO (Ptr FileAttributeInfoList)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileAttributeInfoList))
 -> IO (Ptr FileAttributeInfoList))
-> (Ptr (Ptr GError) -> IO (Ptr FileAttributeInfoList))
-> IO (Ptr FileAttributeInfoList)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileAttributeInfoList)
g_file_query_settable_attributes Ptr File
file' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileAttributeInfoList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQuerySettableAttributes" Ptr FileAttributeInfoList
result
        FileAttributeInfoList
result' <- ((ManagedPtr FileAttributeInfoList -> FileAttributeInfoList)
-> Ptr FileAttributeInfoList -> IO FileAttributeInfoList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FileAttributeInfoList -> FileAttributeInfoList
Gio.FileAttributeInfoList.FileAttributeInfoList) Ptr FileAttributeInfoList
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileAttributeInfoList -> IO FileAttributeInfoList
forall (m :: * -> *) a. Monad m => a -> m a
return FileAttributeInfoList
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileQuerySettableAttributesMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.FileAttributeInfoList.FileAttributeInfoList), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQuerySettableAttributesMethodInfo a signature where
    overloadedMethod = fileQuerySettableAttributes

instance O.OverloadedMethodInfo FileQuerySettableAttributesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQuerySettableAttributes",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQuerySettableAttributes"
        }


#endif

-- method File::query_writable_namespaces
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Gio" , name = "FileAttributeInfoList" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_query_writable_namespaces" g_file_query_writable_namespaces :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileAttributeInfoList.FileAttributeInfoList)

-- | Obtain the list of attribute namespaces where new attributes
-- can be created by a user. An example of this is extended
-- attributes (in the \"xattr\" namespace).
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileQueryWritableNamespaces ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileAttributeInfoList.FileAttributeInfoList
    -- ^ __Returns:__ a t'GI.Gio.Structs.FileAttributeInfoList.FileAttributeInfoList' describing the writable namespaces.
    --     When you are done with it, release it with
    --     'GI.Gio.Structs.FileAttributeInfoList.fileAttributeInfoListUnref' /(Can throw 'Data.GI.Base.GError.GError')/
fileQueryWritableNamespaces :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m FileAttributeInfoList
fileQueryWritableNamespaces a
file Maybe b
cancellable = IO FileAttributeInfoList -> m FileAttributeInfoList
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileAttributeInfoList -> m FileAttributeInfoList)
-> IO FileAttributeInfoList -> m FileAttributeInfoList
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileAttributeInfoList -> IO () -> IO FileAttributeInfoList
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileAttributeInfoList
result <- (Ptr (Ptr GError) -> IO (Ptr FileAttributeInfoList))
-> IO (Ptr FileAttributeInfoList)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileAttributeInfoList))
 -> IO (Ptr FileAttributeInfoList))
-> (Ptr (Ptr GError) -> IO (Ptr FileAttributeInfoList))
-> IO (Ptr FileAttributeInfoList)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileAttributeInfoList)
g_file_query_writable_namespaces Ptr File
file' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileAttributeInfoList -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileQueryWritableNamespaces" Ptr FileAttributeInfoList
result
        FileAttributeInfoList
result' <- ((ManagedPtr FileAttributeInfoList -> FileAttributeInfoList)
-> Ptr FileAttributeInfoList -> IO FileAttributeInfoList
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr FileAttributeInfoList -> FileAttributeInfoList
Gio.FileAttributeInfoList.FileAttributeInfoList) Ptr FileAttributeInfoList
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileAttributeInfoList -> IO FileAttributeInfoList
forall (m :: * -> *) a. Monad m => a -> m a
return FileAttributeInfoList
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileQueryWritableNamespacesMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.FileAttributeInfoList.FileAttributeInfoList), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileQueryWritableNamespacesMethodInfo a signature where
    overloadedMethod = fileQueryWritableNamespaces

instance O.OverloadedMethodInfo FileQueryWritableNamespacesMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileQueryWritableNamespaces",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileQueryWritableNamespaces"
        }


#endif

-- method File::read
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFile to read" , 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" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileInputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_read" g_file_read :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInputStream.FileInputStream)

-- | Opens a file for reading. The result is a t'GI.Gio.Objects.FileInputStream.FileInputStream' that
-- can be used to read the contents of the file.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- If the file does not exist, the 'GI.Gio.Enums.IOErrorEnumNotFound' error will be
-- returned. If the file is a directory, the 'GI.Gio.Enums.IOErrorEnumIsDirectory'
-- error will be returned. Other errors are possible too, and depend
-- on what kind of filesystem the file is on.
fileRead ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: t'GI.Gio.Interfaces.File.File' to read
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m Gio.FileInputStream.FileInputStream
    -- ^ __Returns:__ t'GI.Gio.Objects.FileInputStream.FileInputStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileRead :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m FileInputStream
fileRead a
file Maybe b
cancellable = IO FileInputStream -> m FileInputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInputStream -> m FileInputStream)
-> IO FileInputStream -> m FileInputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileInputStream -> IO () -> IO FileInputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileInputStream))
-> IO (Ptr FileInputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInputStream))
 -> IO (Ptr FileInputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileInputStream))
-> IO (Ptr FileInputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr FileInputStream)
g_file_read Ptr File
file' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileInputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileRead" Ptr FileInputStream
result
        FileInputStream
result' <- ((ManagedPtr FileInputStream -> FileInputStream)
-> Ptr FileInputStream -> IO FileInputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInputStream -> FileInputStream
Gio.FileInputStream.FileInputStream) Ptr FileInputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        FileInputStream -> IO FileInputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileInputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileReadMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.FileInputStream.FileInputStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReadMethodInfo a signature where
    overloadedMethod = fileRead

instance O.OverloadedMethodInfo FileReadMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileRead",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileRead"
        }


#endif

-- method File::read_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_read_async" g_file_read_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously opens /@file@/ for reading.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileRead' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileReadFinish' to get the result
-- of the operation.
fileReadAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileReadAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileReadAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_read_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileReadAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReadAsyncMethodInfo a signature where
    overloadedMethod = fileReadAsync

instance O.OverloadedMethodInfo FileReadAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReadAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReadAsync"
        }


#endif

-- method File::read_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileInputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_read_finish" g_file_read_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileInputStream.FileInputStream)

-- | Finishes an asynchronous file read operation started with
-- 'GI.Gio.Interfaces.File.fileReadAsync'.
fileReadFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileInputStream.FileInputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileInputStream.FileInputStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileReadFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileInputStream
fileReadFinish a
file b
res = IO FileInputStream -> m FileInputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInputStream -> m FileInputStream)
-> IO FileInputStream -> m FileInputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileInputStream -> IO () -> IO FileInputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileInputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileInputStream))
-> IO (Ptr FileInputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileInputStream))
 -> IO (Ptr FileInputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileInputStream))
-> IO (Ptr FileInputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileInputStream)
g_file_read_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileInputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileReadFinish" Ptr FileInputStream
result
        FileInputStream
result' <- ((ManagedPtr FileInputStream -> FileInputStream)
-> Ptr FileInputStream -> IO FileInputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInputStream -> FileInputStream
Gio.FileInputStream.FileInputStream) Ptr FileInputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileInputStream -> IO FileInputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileInputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileReadFinishMethodInfo
instance (signature ~ (b -> m Gio.FileInputStream.FileInputStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileReadFinishMethodInfo a signature where
    overloadedMethod = fileReadFinish

instance O.OverloadedMethodInfo FileReadFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReadFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReadFinish"
        }


#endif

-- method File::replace
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an optional [entity tag][gfile-etag]\n    for the current #GFile, or #NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileOutputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_replace" g_file_replace :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileOutputStream.FileOutputStream)

-- | Returns an output stream for overwriting the file, possibly
-- creating a backup copy of the file first. If the file doesn\'t exist,
-- it will be created.
-- 
-- This will try to replace the file in the safest way possible so
-- that any errors during the writing will not affect an already
-- existing copy of the file. For instance, for local files it
-- may write to a temporary file and then atomically rename over
-- the destination when the stream is closed.
-- 
-- By default files created are generally readable by everyone,
-- but if you pass @/G_FILE_CREATE_PRIVATE/@ in /@flags@/ the file
-- will be made readable only to the current user, to the level that
-- is supported on the target filesystem.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled
-- by triggering the cancellable object from another thread. If the
-- operation was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be
-- returned.
-- 
-- If you pass in a non-'P.Nothing' /@etag@/ value and /@file@/ already exists, then
-- this value is compared to the current entity tag of the file, and if
-- they differ an 'GI.Gio.Enums.IOErrorEnumWrongEtag' error is returned. This
-- generally means that the file has been changed since you last read
-- it. You can get the new etag from 'GI.Gio.Objects.FileOutputStream.fileOutputStreamGetEtag'
-- after you\'ve finished writing and closed the t'GI.Gio.Objects.FileOutputStream.FileOutputStream'. When
-- you load a new file you can use 'GI.Gio.Objects.FileInputStream.fileInputStreamQueryInfo' to
-- get the etag of the file.
-- 
-- If /@makeBackup@/ is 'P.True', this function will attempt to make a
-- backup of the current file before overwriting it. If this fails
-- a 'GI.Gio.Enums.IOErrorEnumCantCreateBackup' error will be returned. If you
-- want to replace anyway, try again with /@makeBackup@/ set to 'P.False'.
-- 
-- If the file is a directory the 'GI.Gio.Enums.IOErrorEnumIsDirectory' error will
-- be returned, and if the file is some other form of non-regular file
-- then a 'GI.Gio.Enums.IOErrorEnumNotRegularFile' error will be returned. Some
-- file systems don\'t allow all file names, and may return an
-- 'GI.Gio.Enums.IOErrorEnumInvalidFilename' error, and if the name is to long
-- 'GI.Gio.Enums.IOErrorEnumFilenameTooLong' will be returned. Other errors are
-- possible too, and depend on what kind of filesystem the file is on.
fileReplace ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (T.Text)
    -- ^ /@etag@/: an optional [entity tag][gfile-etag]
    --     for the current t'GI.Gio.Interfaces.File.File', or @/NULL/@ to ignore
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileOutputStream.FileOutputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileOutputStream.FileOutputStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileReplace :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Maybe b
-> m FileOutputStream
fileReplace a
file Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Maybe b
cancellable = IO FileOutputStream -> m FileOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOutputStream -> m FileOutputStream)
-> IO FileOutputStream -> m FileOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileOutputStream -> IO () -> IO FileOutputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileOutputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
 -> IO (Ptr FileOutputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CInt
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileOutputStream)
g_file_replace Ptr File
file' CString
maybeEtag CInt
makeBackup' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileReplace" Ptr FileOutputStream
result
        FileOutputStream
result' <- ((ManagedPtr FileOutputStream -> FileOutputStream)
-> Ptr FileOutputStream -> IO FileOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileOutputStream -> FileOutputStream
Gio.FileOutputStream.FileOutputStream) Ptr FileOutputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
        FileOutputStream -> IO FileOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileOutputStream
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
     )

#if defined(ENABLE_OVERLOADING)
data FileReplaceMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Maybe (b) -> m Gio.FileOutputStream.FileOutputStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceMethodInfo a signature where
    overloadedMethod = fileReplace

instance O.OverloadedMethodInfo FileReplaceMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplace",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplace"
        }


#endif

-- method File::replace_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an [entity tag][gfile-etag] for the current #GFile,\n    or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_replace_async" g_file_replace_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously overwrites the file, replacing the contents,
-- possibly creating a backup copy of the file first.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileReplace' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileReplaceFinish' to get the result
-- of the operation.
fileReplaceAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (T.Text)
    -- ^ /@etag@/: an [entity tag][gfile-etag] for the current t'GI.Gio.Interfaces.File.File',
    --     or 'P.Nothing' to ignore
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileReplaceAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileReplaceAsync a
file Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CString
-> CInt
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_replace_async Ptr File
file' CString
maybeEtag CInt
makeBackup' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileReplaceAsyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceAsyncMethodInfo a signature where
    overloadedMethod = fileReplaceAsync

instance O.OverloadedMethodInfo FileReplaceAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceAsync"
        }


#endif

-- method File::replace_contents
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a string containing the new contents for @file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @contents in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the old [entity-tag][gfile-etag] for the document,\n    or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location to a new [entity tag][gfile-etag]\n     for the document. This should be freed with g_free() when no longer\n     needed, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @contents in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_replace_contents" g_file_replace_contents :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Word8 ->                            -- contents : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Ptr CString ->                          -- new_etag : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Replaces the contents of /@file@/ with /@contents@/ of /@length@/ bytes.
-- 
-- If /@etag@/ is specified (not 'P.Nothing'), any existing file must have that etag,
-- or the error 'GI.Gio.Enums.IOErrorEnumWrongEtag' will be returned.
-- 
-- If /@makeBackup@/ is 'P.True', this function will attempt to make a backup
-- of /@file@/. Internally, it uses 'GI.Gio.Interfaces.File.fileReplace', so will try to replace the
-- file contents in the safest way possible. For example, atomic renames are
-- used when replacing local files’ contents.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- The returned /@newEtag@/ can be used to verify that the file hasn\'t
-- changed the next time it is saved over.
fileReplaceContents ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> ByteString
    -- ^ /@contents@/: a string containing the new contents for /@file@/
    -> Maybe (T.Text)
    -- ^ /@etag@/: the old [entity-tag][gfile-etag] for the document,
    --     or 'P.Nothing'
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileReplaceContents :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> ByteString
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Maybe b
-> m Text
fileReplaceContents a
file ByteString
contents Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Maybe b
cancellable = IO Text -> m Text
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
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
contents
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Word8
contents' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
contents
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr CString
newEtag <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr Word8
-> Word64
-> CString
-> CInt
-> CUInt
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_replace_contents Ptr File
file' Ptr Word8
contents' Word64
length_ CString
maybeEtag CInt
makeBackup' CUInt
flags' Ptr CString
newEtag Ptr Cancellable
maybeCancellable
        CString
newEtag' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
newEtag
        Text
newEtag'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
newEtag'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newEtag'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
contents'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newEtag
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
newEtag''
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
contents'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newEtag
     )

#if defined(ENABLE_OVERLOADING)
data FileReplaceContentsMethodInfo
instance (signature ~ (ByteString -> Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Maybe (b) -> m (T.Text)), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceContentsMethodInfo a signature where
    overloadedMethod = fileReplaceContents

instance O.OverloadedMethodInfo FileReplaceContentsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceContents",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceContents"
        }


#endif

-- method File::replace_contents_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "string of contents to replace the file with"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of @contents in bytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a new [entity tag][gfile-etag] for the @file, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object, %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 8
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of @contents in bytes"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_replace_contents_async" g_file_replace_contents_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Word8 ->                            -- contents : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    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 ()

-- | Starts an asynchronous replacement of /@file@/ with the given
-- /@contents@/ of /@length@/ bytes. /@etag@/ will replace the document\'s
-- current entity tag.
-- 
-- When this operation has completed, /@callback@/ will be called with
-- /@userUser@/ data, and the operation can be finalized with
-- 'GI.Gio.Interfaces.File.fileReplaceContentsFinish'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- If /@makeBackup@/ is 'P.True', this function will attempt to
-- make a backup of /@file@/.
-- 
-- Note that no copy of /@contents@/ will be made, so it must stay valid
-- until /@callback@/ is called. See 'GI.Gio.Interfaces.File.fileReplaceContentsBytesAsync'
-- for a t'GI.GLib.Structs.Bytes.Bytes' version that will automatically hold a reference to the
-- contents (without copying) for the duration of the call.
fileReplaceContentsAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> ByteString
    -- ^ /@contents@/: string of contents to replace the file with
    -> Maybe (T.Text)
    -- ^ /@etag@/: a new [entity tag][gfile-etag] for the /@file@/, or 'P.Nothing'
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    -> m ()
fileReplaceContentsAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> ByteString
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileReplaceContentsAsync a
file ByteString
contents Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
contents
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Word8
contents' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
contents
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Ptr Word8
-> Word64
-> CString
-> CInt
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_replace_contents_async Ptr File
file' Ptr Word8
contents' Word64
length_ CString
maybeEtag CInt
makeBackup' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
contents'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileReplaceContentsAsyncMethodInfo
instance (signature ~ (ByteString -> Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceContentsAsyncMethodInfo a signature where
    overloadedMethod = fileReplaceContentsAsync

instance O.OverloadedMethodInfo FileReplaceContentsAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceContentsAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceContentsAsync"
        }


#endif

-- method File::replace_contents_bytes_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "contents"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a new [entity tag][gfile-etag] for the @file, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object, %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_replace_contents_bytes_async" g_file_replace_contents_bytes_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr GLib.Bytes.Bytes ->                 -- contents : TInterface (Name {namespace = "GLib", name = "Bytes"})
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    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 ()

-- | Same as 'GI.Gio.Interfaces.File.fileReplaceContentsAsync' but takes a t'GI.GLib.Structs.Bytes.Bytes' input instead.
-- This function will keep a ref on /@contents@/ until the operation is done.
-- Unlike 'GI.Gio.Interfaces.File.fileReplaceContentsAsync' this allows forgetting about the
-- content without waiting for the callback.
-- 
-- When this operation has completed, /@callback@/ will be called with
-- /@userUser@/ data, and the operation can be finalized with
-- 'GI.Gio.Interfaces.File.fileReplaceContentsFinish'.
-- 
-- /Since: 2.40/
fileReplaceContentsBytesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> GLib.Bytes.Bytes
    -- ^ /@contents@/: a t'GI.GLib.Structs.Bytes.Bytes'
    -> Maybe (T.Text)
    -- ^ /@etag@/: a new [entity tag][gfile-etag] for the /@file@/, or 'P.Nothing'
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied
    -> m ()
fileReplaceContentsBytesAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Bytes
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileReplaceContentsBytesAsync a
file Bytes
contents Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Bytes
contents' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
contents
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Ptr Bytes
-> CString
-> CInt
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_replace_contents_bytes_async Ptr File
file' Ptr Bytes
contents' CString
maybeEtag CInt
makeBackup' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
contents
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileReplaceContentsBytesAsyncMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceContentsBytesAsyncMethodInfo a signature where
    overloadedMethod = fileReplaceContentsBytesAsync

instance O.OverloadedMethodInfo FileReplaceContentsBytesAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceContentsBytesAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceContentsBytesAsync"
        }


#endif

-- method File::replace_contents_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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
--           }
--       , Arg
--           { argCName = "new_etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a location of a new [entity tag][gfile-etag]\n    for the document. This should be freed with g_free() when it is no\n    longer needed, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_replace_contents_finish" g_file_replace_contents_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr CString ->                          -- new_etag : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous replace of the given /@file@/. See
-- 'GI.Gio.Interfaces.File.fileReplaceContentsAsync'. Sets /@newEtag@/ to the new entity
-- tag for the document, if present.
fileReplaceContentsFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileReplaceContentsFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m Text
fileReplaceContentsFinish a
file b
res = IO Text -> m Text
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 File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    Ptr CString
newEtag <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr CString -> Ptr (Ptr GError) -> IO CInt
g_file_replace_contents_finish Ptr File
file' Ptr AsyncResult
res' Ptr CString
newEtag
        CString
newEtag' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
newEtag
        Text
newEtag'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
newEtag'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
newEtag'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newEtag
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
newEtag''
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newEtag
     )

#if defined(ENABLE_OVERLOADING)
data FileReplaceContentsFinishMethodInfo
instance (signature ~ (b -> m (T.Text)), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileReplaceContentsFinishMethodInfo a signature where
    overloadedMethod = fileReplaceContentsFinish

instance O.OverloadedMethodInfo FileReplaceContentsFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceContentsFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceContentsFinish"
        }


#endif

-- method File::replace_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileOutputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_replace_finish" g_file_replace_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileOutputStream.FileOutputStream)

-- | Finishes an asynchronous file replace operation started with
-- 'GI.Gio.Interfaces.File.fileReplaceAsync'.
fileReplaceFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileOutputStream.FileOutputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileOutputStream.FileOutputStream', or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileReplaceFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileOutputStream
fileReplaceFinish a
file b
res = IO FileOutputStream -> m FileOutputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileOutputStream -> m FileOutputStream)
-> IO FileOutputStream -> m FileOutputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileOutputStream -> IO () -> IO FileOutputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileOutputStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
 -> IO (Ptr FileOutputStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileOutputStream))
-> IO (Ptr FileOutputStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileOutputStream)
g_file_replace_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileOutputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileReplaceFinish" Ptr FileOutputStream
result
        FileOutputStream
result' <- ((ManagedPtr FileOutputStream -> FileOutputStream)
-> Ptr FileOutputStream -> IO FileOutputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileOutputStream -> FileOutputStream
Gio.FileOutputStream.FileOutputStream) Ptr FileOutputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileOutputStream -> IO FileOutputStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileOutputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileReplaceFinishMethodInfo
instance (signature ~ (b -> m Gio.FileOutputStream.FileOutputStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileReplaceFinishMethodInfo a signature where
    overloadedMethod = fileReplaceFinish

instance O.OverloadedMethodInfo FileReplaceFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceFinish"
        }


#endif

-- method File::replace_readwrite
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an optional [entity tag][gfile-etag]\n    for the current #GFile, or #NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "FileIOStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_replace_readwrite" g_file_replace_readwrite :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileIOStream.FileIOStream)

-- | Returns an output stream for overwriting the file in readwrite mode,
-- possibly creating a backup copy of the file first. If the file doesn\'t
-- exist, it will be created.
-- 
-- For details about the behaviour, see 'GI.Gio.Interfaces.File.fileReplace' which does the
-- same thing but returns an output stream only.
-- 
-- Note that in many non-local file cases read and write streams are not
-- supported, so make sure you really need to do read and write streaming,
-- rather than just opening for reading or writing.
-- 
-- /Since: 2.22/
fileReplaceReadwrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> Maybe (T.Text)
    -- ^ /@etag@/: an optional [entity tag][gfile-etag]
    --     for the current t'GI.Gio.Interfaces.File.File', or @/NULL/@ to ignore
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m Gio.FileIOStream.FileIOStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileIOStream.FileIOStream' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileReplaceReadwrite :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Maybe b
-> m FileIOStream
fileReplaceReadwrite a
file Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Maybe b
cancellable = IO FileIOStream -> m FileIOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileIOStream -> m FileIOStream)
-> IO FileIOStream -> m FileIOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO FileIOStream -> IO () -> IO FileIOStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileIOStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileIOStream))
 -> IO (Ptr FileIOStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CInt
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr FileIOStream)
g_file_replace_readwrite Ptr File
file' CString
maybeEtag CInt
makeBackup' CUInt
flags' Ptr Cancellable
maybeCancellable
        Text -> Ptr FileIOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileReplaceReadwrite" Ptr FileIOStream
result
        FileIOStream
result' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
        FileIOStream -> IO FileIOStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileIOStream
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
     )

#if defined(ENABLE_OVERLOADING)
data FileReplaceReadwriteMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Maybe (b) -> m Gio.FileIOStream.FileIOStream), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceReadwriteMethodInfo a signature where
    overloadedMethod = fileReplaceReadwrite

instance O.OverloadedMethodInfo FileReplaceReadwriteMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceReadwrite",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceReadwrite"
        }


#endif

-- method File::replace_readwrite_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "etag"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an [entity tag][gfile-etag] for the current #GFile,\n    or %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "make_backup"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if a backup should be created"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileCreateFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_replace_readwrite_async" g_file_replace_readwrite_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- etag : TBasicType TUTF8
    CInt ->                                 -- make_backup : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileCreateFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously overwrites the file in read-write mode,
-- replacing the contents, possibly creating a backup copy
-- of the file first.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileReplaceReadwrite' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileReplaceReadwriteFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
fileReplaceReadwriteAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Maybe (T.Text)
    -- ^ /@etag@/: an [entity tag][gfile-etag] for the current t'GI.Gio.Interfaces.File.File',
    --     or 'P.Nothing' to ignore
    -> Bool
    -- ^ /@makeBackup@/: 'P.True' if a backup should be created
    -> [Gio.Flags.FileCreateFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileCreateFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileReplaceReadwriteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Maybe Text
-> Bool
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileReplaceReadwriteAsync a
file Maybe Text
etag Bool
makeBackup [FileCreateFlags]
flags Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
maybeEtag <- case Maybe Text
etag of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jEtag -> do
            CString
jEtag' <- Text -> IO CString
textToCString Text
jEtag
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jEtag'
    let makeBackup' :: CInt
makeBackup' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
makeBackup
    let flags' :: CUInt
flags' = [FileCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileCreateFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CString
-> CInt
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_replace_readwrite_async Ptr File
file' CString
maybeEtag CInt
makeBackup' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeEtag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileReplaceReadwriteAsyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> Bool -> [Gio.Flags.FileCreateFlags] -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileReplaceReadwriteAsyncMethodInfo a signature where
    overloadedMethod = fileReplaceReadwriteAsync

instance O.OverloadedMethodInfo FileReplaceReadwriteAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceReadwriteAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceReadwriteAsync"
        }


#endif

-- method File::replace_readwrite_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 = "FileIOStream" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_replace_readwrite_finish" g_file_replace_readwrite_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.FileIOStream.FileIOStream)

-- | Finishes an asynchronous file replace operation started with
-- 'GI.Gio.Interfaces.File.fileReplaceReadwriteAsync'.
-- 
-- /Since: 2.22/
fileReplaceReadwriteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.FileIOStream.FileIOStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.FileIOStream.FileIOStream', or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileReplaceReadwriteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileIOStream
fileReplaceReadwriteFinish a
file b
res = IO FileIOStream -> m FileIOStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileIOStream -> m FileIOStream)
-> IO FileIOStream -> m FileIOStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO FileIOStream -> IO () -> IO FileIOStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr FileIOStream
result <- (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr FileIOStream))
 -> IO (Ptr FileIOStream))
-> (Ptr (Ptr GError) -> IO (Ptr FileIOStream))
-> IO (Ptr FileIOStream)
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr FileIOStream)
g_file_replace_readwrite_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr FileIOStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileReplaceReadwriteFinish" Ptr FileIOStream
result
        FileIOStream
result' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        FileIOStream -> IO FileIOStream
forall (m :: * -> *) a. Monad m => a -> m a
return FileIOStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileReplaceReadwriteFinishMethodInfo
instance (signature ~ (b -> m Gio.FileIOStream.FileIOStream), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileReplaceReadwriteFinishMethodInfo a signature where
    overloadedMethod = fileReplaceReadwriteFinish

instance O.OverloadedMethodInfo FileReplaceReadwriteFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileReplaceReadwriteFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileReplaceReadwriteFinish"
        }


#endif

-- method File::resolve_relative_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "relative_path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a given relative path string"
--                 , 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 "g_file_resolve_relative_path" g_file_resolve_relative_path :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- relative_path : TBasicType TFileName
    IO (Ptr File)

-- | Resolves a relative path for /@file@/ to an absolute path.
-- 
-- This call does no blocking I\/O.
fileResolveRelativePath ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Char]
    -- ^ /@relativePath@/: a given relative path string
    -> m File
    -- ^ __Returns:__ t'GI.Gio.Interfaces.File.File' to the resolved path.
    --     'P.Nothing' if /@relativePath@/ is 'P.Nothing' or if /@file@/ is invalid.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
fileResolveRelativePath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> [Char] -> m File
fileResolveRelativePath a
file [Char]
relativePath = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
relativePath' <- [Char] -> IO CString
stringToCString [Char]
relativePath
    Ptr File
result <- Ptr File -> CString -> IO (Ptr File)
g_file_resolve_relative_path Ptr File
file' CString
relativePath'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileResolveRelativePath" Ptr File
result
    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
File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
relativePath'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data FileResolveRelativePathMethodInfo
instance (signature ~ ([Char] -> m File), MonadIO m, IsFile a) => O.OverloadedMethod FileResolveRelativePathMethodInfo a signature where
    overloadedMethod = fileResolveRelativePath

instance O.OverloadedMethodInfo FileResolveRelativePathMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileResolveRelativePath",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileResolveRelativePath"
        }


#endif

-- method File::set_attribute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "type"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileAttributeType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The type of the attribute"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value_p"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a pointer to the value (or the pointer\n    itself if the type is a pointer type)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a set of #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute" g_file_set_attribute :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    CUInt ->                                -- type : TInterface (Name {namespace = "Gio", name = "FileAttributeType"})
    Ptr () ->                               -- value_p : TBasicType TPtr
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets an attribute in the file with attribute name /@attribute@/ to /@valueP@/.
-- 
-- Some attributes can be unset by setting /@type@/ to
-- 'GI.Gio.Enums.FileAttributeTypeInvalid' and /@valueP@/ to 'P.Nothing'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttribute ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> Gio.Enums.FileAttributeType
    -- ^ /@type@/: The type of the attribute
    -> Ptr ()
    -- ^ /@valueP@/: a pointer to the value (or the pointer
    --     itself if the type is a pointer type)
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a set of t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttribute :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> Text
-> FileAttributeType
-> Ptr ()
-> [FileQueryInfoFlags]
-> Maybe b
-> m ()
fileSetAttribute a
file Text
attribute FileAttributeType
type_ Ptr ()
valueP [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    let type_' :: CUInt
type_' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FileAttributeType -> Int) -> FileAttributeType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileAttributeType -> Int
forall a. Enum a => a -> Int
fromEnum) FileAttributeType
type_
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CUInt
-> Ptr ()
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute Ptr File
file' CString
attribute' CUInt
type_' Ptr ()
valueP CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeMethodInfo
instance (signature ~ (T.Text -> Gio.Enums.FileAttributeType -> Ptr () -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeMethodInfo a signature where
    overloadedMethod = fileSetAttribute

instance O.OverloadedMethodInfo FileSetAttributeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttribute",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttribute"
        }


#endif

-- method File::set_attribute_byte_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's new value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute_byte_string" g_file_set_attribute_byte_string :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@attribute@/ of type 'GI.Gio.Enums.FileAttributeTypeByteString' to /@value@/.
-- If /@attribute@/ is of a different type, this operation will fail,
-- returning 'P.False'.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributeByteString ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> T.Text
    -- ^ /@value@/: a string containing the attribute\'s new value
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributeByteString :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Text -> [FileQueryInfoFlags] -> Maybe b -> m ()
fileSetAttributeByteString a
file Text
attribute Text
value [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    CString
value' <- Text -> IO CString
textToCString Text
value
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute_byte_string Ptr File
file' CString
attribute' CString
value' CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeByteStringMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeByteStringMethodInfo a signature where
    overloadedMethod = fileSetAttributeByteString

instance O.OverloadedMethodInfo FileSetAttributeByteStringMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributeByteString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributeByteString"
        }


#endif

-- method File::set_attribute_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #gint32 containing the attribute's new value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute_int32" g_file_set_attribute_int32 :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    Int32 ->                                -- value : TBasicType TInt32
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@attribute@/ of type 'GI.Gio.Enums.FileAttributeTypeInt32' to /@value@/.
-- If /@attribute@/ is of a different type, this operation will fail.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributeInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> Int32
    -- ^ /@value@/: a @/gint32/@ containing the attribute\'s new value
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributeInt32 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Int32 -> [FileQueryInfoFlags] -> Maybe b -> m ()
fileSetAttributeInt32 a
file Text
attribute Int32
value [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> Int32
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute_int32 Ptr File
file' CString
attribute' Int32
value CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeInt32MethodInfo
instance (signature ~ (T.Text -> Int32 -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeInt32MethodInfo a signature where
    overloadedMethod = fileSetAttributeInt32

instance O.OverloadedMethodInfo FileSetAttributeInt32MethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributeInt32",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributeInt32"
        }


#endif

-- method File::set_attribute_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #guint64 containing the attribute's new value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute_int64" g_file_set_attribute_int64 :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    Int64 ->                                -- value : TBasicType TInt64
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@attribute@/ of type 'GI.Gio.Enums.FileAttributeTypeInt64' to /@value@/.
-- If /@attribute@/ is of a different type, this operation will fail.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributeInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> Int64
    -- ^ /@value@/: a @/guint64/@ containing the attribute\'s new value
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributeInt64 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Int64 -> [FileQueryInfoFlags] -> Maybe b -> m ()
fileSetAttributeInt64 a
file Text
attribute Int64
value [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> Int64
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute_int64 Ptr File
file' CString
attribute' Int64
value CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeInt64MethodInfo
instance (signature ~ (T.Text -> Int64 -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeInt64MethodInfo a signature where
    overloadedMethod = fileSetAttributeInt64

instance O.OverloadedMethodInfo FileSetAttributeInt64MethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributeInt64",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributeInt64"
        }


#endif

-- method File::set_attribute_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute_string" g_file_set_attribute_string :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@attribute@/ of type 'GI.Gio.Enums.FileAttributeTypeString' to /@value@/.
-- If /@attribute@/ is of a different type, this operation will fail.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributeString ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> T.Text
    -- ^ /@value@/: a string containing the attribute\'s value
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributeString :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Text -> [FileQueryInfoFlags] -> Maybe b -> m ()
fileSetAttributeString a
file Text
attribute Text
value [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    CString
value' <- Text -> IO CString
textToCString Text
value
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> CString
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute_string Ptr File
file' CString
attribute' CString
value' CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeStringMethodInfo
instance (signature ~ (T.Text -> T.Text -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeStringMethodInfo a signature where
    overloadedMethod = fileSetAttributeString

instance O.OverloadedMethodInfo FileSetAttributeStringMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributeString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributeString"
        }


#endif

-- method File::set_attribute_uint32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #guint32 containing the attribute's new value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute_uint32" g_file_set_attribute_uint32 :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    Word32 ->                               -- value : TBasicType TUInt32
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@attribute@/ of type 'GI.Gio.Enums.FileAttributeTypeUint32' to /@value@/.
-- If /@attribute@/ is of a different type, this operation will fail.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributeUint32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> Word32
    -- ^ /@value@/: a @/guint32/@ containing the attribute\'s new value
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributeUint32 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Word32 -> [FileQueryInfoFlags] -> Maybe b -> m ()
fileSetAttributeUint32 a
file Text
attribute Word32
value [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> Word32
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute_uint32 Ptr File
file' CString
attribute' Word32
value CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeUint32MethodInfo
instance (signature ~ (T.Text -> Word32 -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeUint32MethodInfo a signature where
    overloadedMethod = fileSetAttributeUint32

instance O.OverloadedMethodInfo FileSetAttributeUint32MethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributeUint32",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributeUint32"
        }


#endif

-- method File::set_attribute_uint64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attribute"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing the attribute's name"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #guint64 containing the attribute's new value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attribute_uint64" g_file_set_attribute_uint64 :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- attribute : TBasicType TUTF8
    Word64 ->                               -- value : TBasicType TUInt64
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets /@attribute@/ of type 'GI.Gio.Enums.FileAttributeTypeUint64' to /@value@/.
-- If /@attribute@/ is of a different type, this operation will fail.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributeUint64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@attribute@/: a string containing the attribute\'s name
    -> Word64
    -- ^ /@value@/: a @/guint64/@ containing the attribute\'s new value
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributeUint64 :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Word64 -> [FileQueryInfoFlags] -> Maybe b -> m ()
fileSetAttributeUint64 a
file Text
attribute Word64
value [FileQueryInfoFlags]
flags Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
attribute' <- Text -> IO CString
textToCString Text
attribute
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> CString
-> Word64
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attribute_uint64 Ptr File
file' CString
attribute' Word64
value CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
attribute'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributeUint64MethodInfo
instance (signature ~ (T.Text -> Word64 -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetAttributeUint64MethodInfo a signature where
    overloadedMethod = fileSetAttributeUint64

instance O.OverloadedMethodInfo FileSetAttributeUint64MethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributeUint64",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributeUint64"
        }


#endif

-- method File::set_attributes_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileQueryInfoFlags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #gpointer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_set_attributes_async" g_file_set_attributes_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.FileInfo.FileInfo ->            -- info : TInterface (Name {namespace = "Gio", name = "FileInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously sets the attributes of /@file@/ with /@info@/.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileSetAttributesFromInfo',
-- which is the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileSetAttributesFinish' to get
-- the result of the operation.
fileSetAttributesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.FileInfo.IsFileInfo b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@info@/: a t'GI.Gio.Objects.FileInfo.FileInfo'
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: a t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
fileSetAttributesAsync :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsFileInfo b,
 IsCancellable c) =>
a
-> b
-> [FileQueryInfoFlags]
-> Int32
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileSetAttributesAsync a
file b
info [FileQueryInfoFlags]
flags Int32
ioPriority Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr FileInfo
info' <- b -> IO (Ptr FileInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
info
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Ptr FileInfo
-> CUInt
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_set_attributes_async Ptr File
file' Ptr FileInfo
info' CUInt
flags' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
info
    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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSetAttributesAsyncMethodInfo
instance (signature ~ (b -> [Gio.Flags.FileQueryInfoFlags] -> Int32 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.FileInfo.IsFileInfo b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileSetAttributesAsyncMethodInfo a signature where
    overloadedMethod = fileSetAttributesAsync

instance O.OverloadedMethodInfo FileSetAttributesAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributesAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributesAsync"
        }


#endif

-- method File::set_attributes_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attributes_finish" g_file_set_attributes_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr Gio.FileInfo.FileInfo) ->      -- info : TInterface (Name {namespace = "Gio", name = "FileInfo"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes setting an attribute started in 'GI.Gio.Interfaces.File.fileSetAttributesAsync'.
fileSetAttributesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (Gio.FileInfo.FileInfo)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributesFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m FileInfo
fileSetAttributesFinish a
file b
result_ = IO FileInfo -> m FileInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileInfo -> m FileInfo) -> IO FileInfo -> m FileInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr (Ptr FileInfo)
info <- IO (Ptr (Ptr FileInfo))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gio.FileInfo.FileInfo))
    IO FileInfo -> IO () -> IO FileInfo
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr AsyncResult
-> Ptr (Ptr FileInfo)
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attributes_finish Ptr File
file' Ptr AsyncResult
result_' Ptr (Ptr FileInfo)
info
        Ptr FileInfo
info' <- Ptr (Ptr FileInfo) -> IO (Ptr FileInfo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr FileInfo)
info
        FileInfo
info'' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
info'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr FileInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FileInfo)
info
        FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
info''
     ) (do
        Ptr (Ptr FileInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FileInfo)
info
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributesFinishMethodInfo
instance (signature ~ (b -> m (Gio.FileInfo.FileInfo)), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileSetAttributesFinishMethodInfo a signature where
    overloadedMethod = fileSetAttributesFinish

instance O.OverloadedMethodInfo FileSetAttributesFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributesFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributesFinish"
        }


#endif

-- method File::set_attributes_from_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFileInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileQueryInfoFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFileQueryInfoFlags"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_set_attributes_from_info" g_file_set_attributes_from_info :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.FileInfo.FileInfo ->            -- info : TInterface (Name {namespace = "Gio", name = "FileInfo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "FileQueryInfoFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to set all attributes in the t'GI.Gio.Objects.FileInfo.FileInfo' on the target
-- values, not stopping on the first error.
-- 
-- If there is any error during this operation then /@error@/ will
-- be set to the first error. Error on particular fields are flagged
-- by setting the \"status\" field in the attribute value to
-- 'GI.Gio.Enums.FileAttributeStatusErrorSetting', which means you can
-- also detect further errors.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetAttributesFromInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.FileInfo.IsFileInfo b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@info@/: a t'GI.Gio.Objects.FileInfo.FileInfo'
    -> [Gio.Flags.FileQueryInfoFlags]
    -- ^ /@flags@/: t'GI.Gio.Flags.FileQueryInfoFlags'
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileSetAttributesFromInfo :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsFileInfo b,
 IsCancellable c) =>
a -> b -> [FileQueryInfoFlags] -> Maybe c -> m ()
fileSetAttributesFromInfo a
file b
info [FileQueryInfoFlags]
flags Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr FileInfo
info' <- b -> IO (Ptr FileInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
info
    let flags' :: CUInt
flags' = [FileQueryInfoFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [FileQueryInfoFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File
-> Ptr FileInfo
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
g_file_set_attributes_from_info Ptr File
file' Ptr FileInfo
info' CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
info
        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 (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileSetAttributesFromInfoMethodInfo
instance (signature ~ (b -> [Gio.Flags.FileQueryInfoFlags] -> Maybe (c) -> m ()), MonadIO m, IsFile a, Gio.FileInfo.IsFileInfo b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileSetAttributesFromInfoMethodInfo a signature where
    overloadedMethod = fileSetAttributesFromInfo

instance O.OverloadedMethodInfo FileSetAttributesFromInfoMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetAttributesFromInfo",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetAttributesFromInfo"
        }


#endif

-- method File::set_display_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "display_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string" , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 "g_file_set_display_name" g_file_set_display_name :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- display_name : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr File)

-- | Renames /@file@/ to the specified display name.
-- 
-- The display name is converted from UTF-8 to the correct encoding
-- for the target filesystem if possible and the /@file@/ is renamed to this.
-- 
-- If you want to implement a rename operation in the user interface the
-- edit name ('GI.Gio.Constants.FILE_ATTRIBUTE_STANDARD_EDIT_NAME') should be used as the
-- initial value in the rename widget, and then the result after editing
-- should be passed to 'GI.Gio.Interfaces.File.fileSetDisplayName'.
-- 
-- On success the resulting converted filename is returned.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileSetDisplayName ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@displayName@/: a string
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' specifying what /@file@/ was renamed to,
    --     or 'P.Nothing' if there was an error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileSetDisplayName :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Maybe b -> m File
fileSetDisplayName a
file Text
displayName Maybe b
cancellable = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
displayName' <- Text -> IO CString
textToCString Text
displayName
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO File -> IO () -> IO 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 File
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr File)
g_file_set_display_name Ptr File
file' CString
displayName' Ptr Cancellable
maybeCancellable
        Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSetDisplayName" Ptr File
result
        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
File) Ptr File
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
displayName'
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
displayName'
     )

#if defined(ENABLE_OVERLOADING)
data FileSetDisplayNameMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m File), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetDisplayNameMethodInfo a signature where
    overloadedMethod = fileSetDisplayName

instance O.OverloadedMethodInfo FileSetDisplayNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetDisplayName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetDisplayName"
        }


#endif

-- method File::set_display_name_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "display_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_set_display_name_async" g_file_set_display_name_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- display_name : TBasicType TUTF8
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously sets the display name for a given t'GI.Gio.Interfaces.File.File'.
-- 
-- For more details, see 'GI.Gio.Interfaces.File.fileSetDisplayName' which is
-- the synchronous version of this call.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileSetDisplayNameFinish' to get
-- the result of the operation.
fileSetDisplayNameAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> T.Text
    -- ^ /@displayName@/: a string
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileSetDisplayNameAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Text -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileSetDisplayNameAsync a
file Text
displayName Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CString
displayName' <- Text -> IO CString
textToCString Text
displayName
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CString
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_set_display_name_async Ptr File
file' CString
displayName' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
displayName'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileSetDisplayNameAsyncMethodInfo
instance (signature ~ (T.Text -> Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileSetDisplayNameAsyncMethodInfo a signature where
    overloadedMethod = fileSetDisplayNameAsync

instance O.OverloadedMethodInfo FileSetDisplayNameAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetDisplayNameAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetDisplayNameAsync"
        }


#endif

-- method File::set_display_name_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "res"
--           , 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 "g_file_set_display_name_finish" g_file_set_display_name_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- res : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr File)

-- | Finishes setting a display name started with
-- 'GI.Gio.Interfaces.File.fileSetDisplayNameAsync'.
fileSetDisplayNameFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@res@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' or 'P.Nothing' on error.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileSetDisplayNameFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m File
fileSetDisplayNameFinish a
file b
res = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
res' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
res
    IO File -> IO () -> IO 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 File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr File)
g_file_set_display_name_finish Ptr File
file' Ptr AsyncResult
res'
        Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileSetDisplayNameFinish" Ptr File
result
        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
File) Ptr File
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
res
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileSetDisplayNameFinishMethodInfo
instance (signature ~ (b -> m File), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileSetDisplayNameFinishMethodInfo a signature where
    overloadedMethod = fileSetDisplayNameFinish

instance O.OverloadedMethodInfo FileSetDisplayNameFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSetDisplayNameFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSetDisplayNameFinish"
        }


#endif

-- method File::start_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "DriveStartFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "start_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation, or %NULL to avoid user interaction"
--                 , 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 "optional #GCancellable object, %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_start_mountable" g_file_start_mountable :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "DriveStartFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- start_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    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 ()

-- | Starts a file of type @/G_FILE_TYPE_MOUNTABLE/@.
-- Using /@startOperation@/, you can request callbacks when, for instance,
-- passwords are needed during authentication.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileMountMountableFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
fileStartMountable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.DriveStartFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@startOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation', or 'P.Nothing' to avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is satisfied, or 'P.Nothing'
    -> m ()
fileStartMountable :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsMountOperation b,
 IsCancellable c) =>
a
-> [DriveStartFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileStartMountable a
file [DriveStartFlags]
flags Maybe b
startOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [DriveStartFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [DriveStartFlags]
flags
    Ptr MountOperation
maybeStartOperation <- case Maybe b
startOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jStartOperation -> do
            Ptr MountOperation
jStartOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jStartOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jStartOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_start_mountable Ptr File
file' CUInt
flags' Ptr MountOperation
maybeStartOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
startOperation 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileStartMountableMethodInfo
instance (signature ~ ([Gio.Flags.DriveStartFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileStartMountableMethodInfo a signature where
    overloadedMethod = fileStartMountable

instance O.OverloadedMethodInfo FileStartMountableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileStartMountable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileStartMountable"
        }


#endif

-- method File::start_mountable_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_start_mountable_finish" g_file_start_mountable_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a start operation. See 'GI.Gio.Interfaces.File.fileStartMountable' for details.
-- 
-- Finish an asynchronous start operation that was started
-- with 'GI.Gio.Interfaces.File.fileStartMountable'.
-- 
-- /Since: 2.22/
fileStartMountableFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileStartMountableFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileStartMountableFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_start_mountable_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileStartMountableFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileStartMountableFinishMethodInfo a signature where
    overloadedMethod = fileStartMountableFinish

instance O.OverloadedMethodInfo FileStartMountableFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileStartMountableFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileStartMountableFinish"
        }


#endif

-- method File::stop_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation,\n    or %NULL to avoid user interaction."
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_stop_mountable" g_file_stop_mountable :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    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 ()

-- | Stops a file of type @/G_FILE_TYPE_MOUNTABLE/@.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileStopMountableFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
fileStopMountable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation',
    --     or 'P.Nothing' to avoid user interaction.
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileStopMountable :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileStopMountable a
file [MountUnmountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_stop_mountable Ptr File
file' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileStopMountableMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileStopMountableMethodInfo a signature where
    overloadedMethod = fileStopMountable

instance O.OverloadedMethodInfo FileStopMountableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileStopMountable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileStopMountable"
        }


#endif

-- method File::stop_mountable_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_stop_mountable_finish" g_file_stop_mountable_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a stop operation, see 'GI.Gio.Interfaces.File.fileStopMountable' for details.
-- 
-- Finish an asynchronous stop operation that was started
-- with 'GI.Gio.Interfaces.File.fileStopMountable'.
-- 
-- /Since: 2.22/
fileStopMountableFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileStopMountableFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileStopMountableFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_stop_mountable_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileStopMountableFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileStopMountableFinishMethodInfo a signature where
    overloadedMethod = fileStopMountableFinish

instance O.OverloadedMethodInfo FileStopMountableFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileStopMountableFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileStopMountableFinish"
        }


#endif

-- method File::supports_thread_contexts
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile" , 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 "g_file_supports_thread_contexts" g_file_supports_thread_contexts :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    IO CInt

-- | Checks if /@file@/ supports
-- [thread-default contexts][g-main-context-push-thread-default-context].
-- If this returns 'P.False', you cannot perform asynchronous operations on
-- /@file@/ in a thread that has a thread-default context.
-- 
-- /Since: 2.22/
fileSupportsThreadContexts ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a) =>
    a
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> m Bool
    -- ^ __Returns:__ Whether or not /@file@/ supports thread-default contexts.
fileSupportsThreadContexts :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m Bool
fileSupportsThreadContexts a
file = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    CInt
result <- Ptr File -> IO CInt
g_file_supports_thread_contexts Ptr File
file'
    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
file
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data FileSupportsThreadContextsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsFile a) => O.OverloadedMethod FileSupportsThreadContextsMethodInfo a signature where
    overloadedMethod = fileSupportsThreadContexts

instance O.OverloadedMethodInfo FileSupportsThreadContextsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileSupportsThreadContexts",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileSupportsThreadContexts"
        }


#endif

-- method File::trash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "#GFile to send to trash"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_trash" g_file_trash :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sends /@file@/ to the \"Trashcan\", if possible. This is similar to
-- deleting it, but the user can recover it before emptying the trashcan.
-- Not all file systems support trashing, so this call can return the
-- 'GI.Gio.Enums.IOErrorEnumNotSupported' error. Since GLib 2.66, the @x-gvfs-notrash@ unix
-- mount option can be used to disable 'GI.Gio.Interfaces.File.fileTrash' support for certain
-- mounts, the 'GI.Gio.Enums.IOErrorEnumNotSupported' error will be returned in that case.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
fileTrash ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: t'GI.Gio.Interfaces.File.File' to send to trash
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileTrash :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Maybe b -> m ()
fileTrash a
file Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
g_file_trash Ptr File
file' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileTrashMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileTrashMethodInfo a signature where
    overloadedMethod = fileTrash

instance O.OverloadedMethodInfo FileTrashMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileTrash",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileTrash"
        }


#endif

-- method File::trash_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "io_priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the [I/O priority][io-priority] of the request"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_trash_async" g_file_trash_async :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int32 ->                                -- io_priority : TBasicType TInt
    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 ()

-- | Asynchronously sends /@file@/ to the Trash location, if possible.
-- 
-- /Since: 2.38/
fileTrashAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> Int32
    -- ^ /@ioPriority@/: the [I\/O priority][io-priority] of the request
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied
    -> m ()
fileTrashAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileTrashAsync a
file Int32
ioPriority Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> Int32
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_trash_async Ptr File
file' Int32
ioPriority Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileTrashAsyncMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileTrashAsyncMethodInfo a signature where
    overloadedMethod = fileTrashAsync

instance O.OverloadedMethodInfo FileTrashAsyncMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileTrashAsync",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileTrashAsync"
        }


#endif

-- method File::trash_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_trash_finish" g_file_trash_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous file trashing operation, started with
-- 'GI.Gio.Interfaces.File.fileTrashAsync'.
-- 
-- /Since: 2.38/
fileTrashFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileTrashFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileTrashFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_trash_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileTrashFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileTrashFinishMethodInfo a signature where
    overloadedMethod = fileTrashFinish

instance O.OverloadedMethodInfo FileTrashFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileTrashFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileTrashFinish"
        }


#endif

-- method File::unmount_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , 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 "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_unmount_mountable" g_file_unmount_mountable :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    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 ()

{-# DEPRECATED fileUnmountMountable ["(Since version 2.22)","Use 'GI.Gio.Interfaces.File.fileUnmountMountableWithOperation' instead."] #-}
-- | Unmounts a file of type G_FILE_TYPE_MOUNTABLE.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileUnmountMountableFinish' to get
-- the result of the operation.
fileUnmountMountable ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileUnmountMountable :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsCancellable b) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileUnmountMountable a
file [MountUnmountFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_unmount_mountable Ptr File
file' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileUnmountMountableMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod FileUnmountMountableMethodInfo a signature where
    overloadedMethod = fileUnmountMountable

instance O.OverloadedMethodInfo FileUnmountMountableMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileUnmountMountable",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileUnmountMountable"
        }


#endif

-- method File::unmount_mountable_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_unmount_mountable_finish" g_file_unmount_mountable_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED fileUnmountMountableFinish ["(Since version 2.22)","Use 'GI.Gio.Interfaces.File.fileUnmountMountableWithOperationFinish'","    instead."] #-}
-- | Finishes an unmount operation, see 'GI.Gio.Interfaces.File.fileUnmountMountable' for details.
-- 
-- Finish an asynchronous unmount operation that was started
-- with 'GI.Gio.Interfaces.File.fileUnmountMountable'.
fileUnmountMountableFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileUnmountMountableFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileUnmountMountableFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_unmount_mountable_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileUnmountMountableFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileUnmountMountableFinishMethodInfo a signature where
    overloadedMethod = fileUnmountMountableFinish

instance O.OverloadedMethodInfo FileUnmountMountableFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileUnmountMountableFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileUnmountMountableFinish"
        }


#endif

-- method File::unmount_mountable_with_operation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation,\n    or %NULL to avoid user interaction"
--                 , 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 "optional #GCancellable object,\n    %NULL to ignore"
--                 , 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 #GAsyncReadyCallback to call\n    when the request is satisfied, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the data to pass to callback function"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_file_unmount_mountable_with_operation" g_file_unmount_mountable_with_operation :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    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 ()

-- | Unmounts a file of type @/G_FILE_TYPE_MOUNTABLE/@.
-- 
-- If /@cancellable@/ is not 'P.Nothing', then the operation can be cancelled by
-- triggering the cancellable object from another thread. If the operation
-- was cancelled, the error 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned.
-- 
-- When the operation is finished, /@callback@/ will be called.
-- You can then call 'GI.Gio.Interfaces.File.fileUnmountMountableFinish' to get
-- the result of the operation.
-- 
-- /Since: 2.22/
fileUnmountMountableWithOperation ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation',
    --     or 'P.Nothing' to avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object,
    --     'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call
    --     when the request is satisfied, or 'P.Nothing'
    -> m ()
fileUnmountMountableWithOperation :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsFile a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileUnmountMountableWithOperation a
file [MountUnmountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
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 (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 (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_WithClosures -> 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 -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback 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 (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 File
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_file_unmount_mountable_with_operation Ptr File
file' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation 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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data FileUnmountMountableWithOperationMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsFile a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod FileUnmountMountableWithOperationMethodInfo a signature where
    overloadedMethod = fileUnmountMountableWithOperation

instance O.OverloadedMethodInfo FileUnmountMountableWithOperationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileUnmountMountableWithOperation",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileUnmountMountableWithOperation"
        }


#endif

-- method File::unmount_mountable_with_operation_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "input #GFile" , 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 (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_file_unmount_mountable_with_operation_finish" g_file_unmount_mountable_with_operation_finish :: 
    Ptr File ->                             -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an unmount operation,
-- see 'GI.Gio.Interfaces.File.fileUnmountMountableWithOperation' for details.
-- 
-- Finish an asynchronous unmount operation that was started
-- with 'GI.Gio.Interfaces.File.fileUnmountMountableWithOperation'.
-- 
-- /Since: 2.22/
fileUnmountMountableWithOperationFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@file@/: input t'GI.Gio.Interfaces.File.File'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
fileUnmountMountableWithOperationFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsFile a, IsAsyncResult b) =>
a -> b -> m ()
fileUnmountMountableWithOperationFinish a
file b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_file_unmount_mountable_with_operation_finish Ptr File
file' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data FileUnmountMountableWithOperationFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsFile a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod FileUnmountMountableWithOperationFinishMethodInfo a signature where
    overloadedMethod = fileUnmountMountableWithOperationFinish

instance O.OverloadedMethodInfo FileUnmountMountableWithOperationFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.File.fileUnmountMountableWithOperationFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-File.html#v:fileUnmountMountableWithOperationFinish"
        }


#endif

-- method File::new_for_commandline_arg
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "arg"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a command line string"
--                 , 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 "g_file_new_for_commandline_arg" g_file_new_for_commandline_arg :: 
    CString ->                              -- arg : TBasicType TFileName
    IO (Ptr File)

-- | Creates a t'GI.Gio.Interfaces.File.File' with the given argument from the command line.
-- The value of /@arg@/ can be either a URI, an absolute path or a
-- relative path resolved relative to the current working directory.
-- This operation never fails, but the returned object might not
-- support any I\/O operation if /@arg@/ points to a malformed path.
-- 
-- Note that on Windows, this function expects its argument to be in
-- UTF-8 -- not the system code page.  This means that you
-- should not use this function with string from argv as it is passed
-- to @/main()/@.  @/g_win32_get_command_line()/@ will return a UTF-8 version of
-- the commandline.  t'GI.Gio.Objects.Application.Application' also uses UTF-8 but
-- 'GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineCreateFileForArg' may be more useful
-- for you there.  It is also always possible to use this function with
-- t'GI.GLib.Structs.OptionContext.OptionContext' arguments of type 'GI.GLib.Enums.OptionArgFilename'.
fileNewForCommandlineArg ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@arg@/: a command line string
    -> m File
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File'.
    --    Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
fileNewForCommandlineArg :: forall (m :: * -> *). (HasCallStack, MonadIO m) => [Char] -> m File
fileNewForCommandlineArg [Char]
arg = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    CString
arg' <- [Char] -> IO CString
stringToCString [Char]
arg
    Ptr File
result <- CString -> IO (Ptr File)
g_file_new_for_commandline_arg CString
arg'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileNewForCommandlineArg" Ptr File
result
    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
File) Ptr File
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
arg'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method File::new_for_commandline_arg_and_cwd
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "arg"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a command line string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cwd"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the current working directory of the commandline"
--                 , 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 "g_file_new_for_commandline_arg_and_cwd" g_file_new_for_commandline_arg_and_cwd :: 
    CString ->                              -- arg : TBasicType TFileName
    CString ->                              -- cwd : TBasicType TFileName
    IO (Ptr File)

-- | Creates a t'GI.Gio.Interfaces.File.File' with the given argument from the command line.
-- 
-- This function is similar to 'GI.Gio.Functions.fileNewForCommandlineArg' except
-- that it allows for passing the current working directory as an
-- argument instead of using the current working directory of the
-- process.
-- 
-- This is useful if the commandline argument was given in a context
-- other than the invocation of the current process.
-- 
-- See also 'GI.Gio.Objects.ApplicationCommandLine.applicationCommandLineCreateFileForArg'.
-- 
-- /Since: 2.36/
fileNewForCommandlineArgAndCwd ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@arg@/: a command line string
    -> [Char]
    -- ^ /@cwd@/: the current working directory of the commandline
    -> m File
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File'
fileNewForCommandlineArgAndCwd :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Char] -> [Char] -> m File
fileNewForCommandlineArgAndCwd [Char]
arg [Char]
cwd = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    CString
arg' <- [Char] -> IO CString
stringToCString [Char]
arg
    CString
cwd' <- [Char] -> IO CString
stringToCString [Char]
cwd
    Ptr File
result <- CString -> CString -> IO (Ptr File)
g_file_new_for_commandline_arg_and_cwd CString
arg' CString
cwd'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileNewForCommandlineArgAndCwd" Ptr File
result
    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
File) Ptr File
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
arg'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
cwd'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method File::new_for_path
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string containing a relative or absolute path.\n    The string must be encoded in the glib filename encoding."
--                 , 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 "g_file_new_for_path" g_file_new_for_path :: 
    CString ->                              -- path : TBasicType TFileName
    IO (Ptr File)

-- | Constructs a t'GI.Gio.Interfaces.File.File' for a given path. This operation never
-- fails, but the returned object might not support any I\/O
-- operation if /@path@/ is malformed.
fileNewForPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@path@/: a string containing a relative or absolute path.
    --     The string must be encoded in the glib filename encoding.
    -> m File
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File' for the given /@path@/.
    --   Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
fileNewForPath :: forall (m :: * -> *). (HasCallStack, MonadIO m) => [Char] -> m File
fileNewForPath [Char]
path = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- [Char] -> IO CString
stringToCString [Char]
path
    Ptr File
result <- CString -> IO (Ptr File)
g_file_new_for_path CString
path'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileNewForPath" Ptr File
result
    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
File) Ptr File
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method File::new_for_uri
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a UTF-8 string containing a URI"
--                 , 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 "g_file_new_for_uri" g_file_new_for_uri :: 
    CString ->                              -- uri : TBasicType TUTF8
    IO (Ptr File)

-- | Constructs a t'GI.Gio.Interfaces.File.File' for a given URI. This operation never
-- fails, but the returned object might not support any I\/O
-- operation if /@uri@/ is malformed or if the uri type is
-- not supported.
fileNewForUri ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uri@/: a UTF-8 string containing a URI
    -> m File
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File' for the given /@uri@/.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
fileNewForUri :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m File
fileNewForUri Text
uri = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr File
result <- CString -> IO (Ptr File)
g_file_new_for_uri CString
uri'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileNewForUri" Ptr File
result
    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
File) Ptr File
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method File::new_tmp
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "tmpl"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Template for the file\n  name, as in g_file_open_tmp(), or %NULL for a default template"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "iostream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileIOStream" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "on return, a #GFileIOStream for the created file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : True
-- Skip return : False

foreign import ccall "g_file_new_tmp" g_file_new_tmp :: 
    CString ->                              -- tmpl : TBasicType TFileName
    Ptr (Ptr Gio.FileIOStream.FileIOStream) -> -- iostream : TInterface (Name {namespace = "Gio", name = "FileIOStream"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr File)

-- | Opens a file in the preferred directory for temporary files (as
-- returned by 'GI.GLib.Functions.getTmpDir') and returns a t'GI.Gio.Interfaces.File.File' and
-- t'GI.Gio.Objects.FileIOStream.FileIOStream' pointing to it.
-- 
-- /@tmpl@/ should be a string in the GLib file name encoding
-- containing a sequence of six \'X\' characters, and containing no
-- directory components. If it is 'P.Nothing', a default template is used.
-- 
-- Unlike the other t'GI.Gio.Interfaces.File.File' constructors, this will return 'P.Nothing' if
-- a temporary file could not be created.
-- 
-- /Since: 2.32/
fileNewTmp ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe ([Char])
    -- ^ /@tmpl@/: Template for the file
    --   name, as in 'GI.GLib.Functions.fileOpenTmp', or 'P.Nothing' for a default template
    -> m ((File, Gio.FileIOStream.FileIOStream))
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File'.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'. /(Can throw 'Data.GI.Base.GError.GError')/
fileNewTmp :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe [Char] -> m (File, FileIOStream)
fileNewTmp Maybe [Char]
tmpl = IO (File, FileIOStream) -> m (File, FileIOStream)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (File, FileIOStream) -> m (File, FileIOStream))
-> IO (File, FileIOStream) -> m (File, FileIOStream)
forall a b. (a -> b) -> a -> b
$ do
    CString
maybeTmpl <- case Maybe [Char]
tmpl of
        Maybe [Char]
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just [Char]
jTmpl -> do
            CString
jTmpl' <- [Char] -> IO CString
stringToCString [Char]
jTmpl
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTmpl'
    Ptr (Ptr FileIOStream)
iostream <- IO (Ptr (Ptr FileIOStream))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Gio.FileIOStream.FileIOStream))
    IO (File, FileIOStream) -> IO () -> IO (File, FileIOStream)
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
$ CString
-> Ptr (Ptr FileIOStream) -> Ptr (Ptr GError) -> IO (Ptr File)
g_file_new_tmp CString
maybeTmpl Ptr (Ptr FileIOStream)
iostream
        Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileNewTmp" Ptr File
result
        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
File) Ptr File
result
        Ptr FileIOStream
iostream' <- Ptr (Ptr FileIOStream) -> IO (Ptr FileIOStream)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr FileIOStream)
iostream
        FileIOStream
iostream'' <- ((ManagedPtr FileIOStream -> FileIOStream)
-> Ptr FileIOStream -> IO FileIOStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileIOStream -> FileIOStream
Gio.FileIOStream.FileIOStream) Ptr FileIOStream
iostream'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTmpl
        Ptr (Ptr FileIOStream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FileIOStream)
iostream
        (File, FileIOStream) -> IO (File, FileIOStream)
forall (m :: * -> *) a. Monad m => a -> m a
return (File
result', FileIOStream
iostream'')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTmpl
        Ptr (Ptr FileIOStream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FileIOStream)
iostream
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method File::parse_name
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "parse_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a file name or path to be parsed"
--                 , 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 "g_file_parse_name" g_file_parse_name :: 
    CString ->                              -- parse_name : TBasicType TUTF8
    IO (Ptr File)

-- | Constructs a t'GI.Gio.Interfaces.File.File' with the given /@parseName@/ (i.e. something
-- given by 'GI.Gio.Interfaces.File.fileGetParseName'). This operation never fails,
-- but the returned object might not support any I\/O operation if
-- the /@parseName@/ cannot be parsed.
fileParseName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@parseName@/: a file name or path to be parsed
    -> m File
    -- ^ __Returns:__ a new t'GI.Gio.Interfaces.File.File'.
fileParseName :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m File
fileParseName Text
parseName = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    CString
parseName' <- Text -> IO CString
textToCString Text
parseName
    Ptr File
result <- CString -> IO (Ptr File)
g_file_parse_name CString
parseName'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"fileParseName" Ptr File
result
    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
File) Ptr File
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
parseName'
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList File = FileSignalList
type FileSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif