{-# 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(..)                                ,
    noFile                                  ,
    IsFile                                  ,
    toFile                                  ,


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

#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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.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 (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)
-- | A convenience alias for `Nothing` :: `Maybe` `File`.
noFile :: Maybe File
noFile :: Maybe File
noFile = Maybe File
forall a. Maybe a
Nothing

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

#endif

foreign import ccall "g_file_get_type"
    c_g_file_get_type :: IO GType

instance GObject File where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_file_get_type
    

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

-- | Type class for types which can be safely cast to `File`, for instance with `toFile`.
class (GObject o, O.IsDescendantOf File o) => IsFile o
instance (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 :: (MonadIO m, IsFile o) => o -> m File
toFile :: o -> m File
toFile = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr File -> File
File

#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.MethodInfo 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

#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 :: a -> [FileCreateFlags] -> Maybe b -> m FileOutputStream
fileAppendTo file :: a
file flags :: [FileCreateFlags]
flags cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 "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.MethodInfo FileAppendToMethodInfo a signature where
    overloadedMethod = 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 :: a
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileAppendToAsync file :: a
file flags :: [FileCreateFlags]
flags ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileAppendToAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m FileOutputStream
fileAppendToFinish file :: a
file res :: 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 "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.MethodInfo FileAppendToFinishMethodInfo a signature where
    overloadedMethod = 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 :: a
-> b
-> [FileCopyFlags]
-> Maybe c
-> Maybe FileProgressCallback
-> m ()
fileCopy source :: a
source destination :: b
destination flags :: [FileCopyFlags]
flags cancellable :: Maybe c
cancellable progressCallback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jProgressCallback :: 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.MethodInfo FileCopyMethodInfo a signature where
    overloadedMethod = fileCopy

#endif

-- XXX Could not generate method File::copy_async
-- Error was : Bad introspection data: "ScopeTypeNotified without destructor! Callable\n  { returnType = Nothing\n  , returnMayBeNull = False\n  , returnTransfer = TransferNothing\n  , returnDocumentation =\n      Documentation { rawDocText = Nothing , sinceVersion = Nothing }\n  , args =\n      [ Arg\n          { argCName = \"source\"\n          , argType = TInterface Name { namespace = \"Gio\" , name = \"File\" }\n          , direction = DirectionIn\n          , mayBeNull = False\n          , argDoc =\n              Documentation\n                { rawDocText = Just \"input #GFile\" , sinceVersion = Nothing }\n          , argScope = ScopeTypeInvalid\n          , argClosure = -1\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"destination\"\n          , argType = TInterface Name { namespace = \"Gio\" , name = \"File\" }\n          , direction = DirectionIn\n          , mayBeNull = False\n          , argDoc =\n              Documentation\n                { rawDocText = Just \"destination #GFile\" , sinceVersion = Nothing }\n          , argScope = ScopeTypeInvalid\n          , argClosure = -1\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"flags\"\n          , argType =\n              TInterface Name { namespace = \"Gio\" , name = \"FileCopyFlags\" }\n          , direction = DirectionIn\n          , mayBeNull = False\n          , argDoc =\n              Documentation\n                { rawDocText = Just \"set of #GFileCopyFlags\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeInvalid\n          , argClosure = -1\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"io_priority\"\n          , argType = TBasicType TInt\n          , direction = DirectionIn\n          , mayBeNull = False\n          , argDoc =\n              Documentation\n                { rawDocText =\n                    Just \"the [I/O priority][io-priority] of the request\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeInvalid\n          , argClosure = -1\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"cancellable\"\n          , argType =\n              TInterface Name { namespace = \"Gio\" , name = \"Cancellable\" }\n          , direction = DirectionIn\n          , mayBeNull = True\n          , argDoc =\n              Documentation\n                { rawDocText =\n                    Just \"optional #GCancellable object,\\n    %NULL to ignore\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeInvalid\n          , argClosure = -1\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"progress_callback\"\n          , argType =\n              TInterface\n                Name { namespace = \"Gio\" , name = \"FileProgressCallback\" }\n          , direction = DirectionIn\n          , mayBeNull = True\n          , argDoc =\n              Documentation\n                { rawDocText =\n                    Just\n                      \"function to callback with progress\\n    information, or %NULL if progress information is not needed\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeNotified\n          , argClosure = 6\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"progress_callback_data\"\n          , argType = TBasicType TPtr\n          , direction = DirectionIn\n          , mayBeNull = True\n          , argDoc =\n              Documentation\n                { rawDocText = Just \"user data to pass to @progress_callback\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeInvalid\n          , argClosure = 5\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"callback\"\n          , argType =\n              TInterface Name { namespace = \"Gio\" , name = \"AsyncReadyCallback\" }\n          , direction = DirectionIn\n          , mayBeNull = True\n          , argDoc =\n              Documentation\n                { rawDocText =\n                    Just \"a #GAsyncReadyCallback to call when the request is satisfied\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeAsync\n          , argClosure = 8\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      , Arg\n          { argCName = \"user_data\"\n          , argType = TBasicType TPtr\n          , direction = DirectionIn\n          , mayBeNull = True\n          , argDoc =\n              Documentation\n                { rawDocText = Just \"the data to pass to callback function\"\n                , sinceVersion = Nothing\n                }\n          , argScope = ScopeTypeInvalid\n          , argClosure = 7\n          , argDestroy = -1\n          , argCallerAllocates = False\n          , transfer = TransferNothing\n          }\n      ]\n  , skipReturn = False\n  , callableThrows = False\n  , callableDeprecated = Nothing\n  , callableDocumentation =\n      Documentation\n        { rawDocText =\n            Just\n              \"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.\"\n        , sinceVersion = Nothing\n        }\n  }"
#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.MethodInfo FileCopyAsyncMethodInfo o p where
    overloadedMethod = 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 :: a -> b -> [FileCopyFlags] -> Maybe c -> m ()
fileCopyAttributes source :: a
source destination :: b
destination flags :: [FileCopyFlags]
flags cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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.MethodInfo FileCopyAttributesMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m ()
fileCopyFinish file :: a
file res :: 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.MethodInfo FileCopyFinishMethodInfo a signature where
    overloadedMethod = 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 :: a -> [FileCreateFlags] -> Maybe b -> m FileOutputStream
fileCreate file :: a
file flags :: [FileCreateFlags]
flags cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 "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.MethodInfo FileCreateMethodInfo a signature where
    overloadedMethod = 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 :: a
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileCreateAsync file :: a
file flags :: [FileCreateFlags]
flags ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileCreateAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m FileOutputStream
fileCreateFinish file :: a
file res :: 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 "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.MethodInfo FileCreateFinishMethodInfo a signature where
    overloadedMethod = 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 :: a -> [FileCreateFlags] -> Maybe b -> m FileIOStream
fileCreateReadwrite file :: a
file flags :: [FileCreateFlags]
flags cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 "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.MethodInfo FileCreateReadwriteMethodInfo a signature where
    overloadedMethod = 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 :: a
-> [FileCreateFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileCreateReadwriteAsync file :: a
file flags :: [FileCreateFlags]
flags ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileCreateReadwriteAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m FileIOStream
fileCreateReadwriteFinish file :: a
file res :: 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 "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.MethodInfo FileCreateReadwriteFinishMethodInfo a signature where
    overloadedMethod = 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 /@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 :: a -> Maybe b -> m ()
fileDelete file :: a
file cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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.MethodInfo FileDeleteMethodInfo a signature where
    overloadedMethod = 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 :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileDeleteAsync file :: a
file ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileDeleteAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m ()
fileDeleteFinish file :: a
file result_ :: 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.MethodInfo FileDeleteFinishMethodInfo a signature where
    overloadedMethod = 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 :: a -> m File
fileDup file :: 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 "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.MethodInfo FileDupMethodInfo a signature where
    overloadedMethod = 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 :: a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileEjectMountable file :: a
file flags :: [MountUnmountFlags]
flags cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileEjectMountableMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m ()
fileEjectMountableFinish file :: a
file result_ :: 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.MethodInfo FileEjectMountableFinishMethodInfo a signature where
    overloadedMethod = 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 :: a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
fileEjectMountableWithOperation file :: a
file flags :: [MountUnmountFlags]
flags mountOperation :: Maybe b
mountOperation cancellable :: Maybe c
cancellable callback :: 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
        Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just jMountOperation :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileEjectMountableWithOperationMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m ()
fileEjectMountableWithOperationFinish file :: a
file result_ :: 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.MethodInfo FileEjectMountableWithOperationFinishMethodInfo a signature where
    overloadedMethod = 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](#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 :: a -> Text -> [FileQueryInfoFlags] -> Maybe b -> m FileEnumerator
fileEnumerateChildren file :: a
file attributes :: Text
attributes flags :: [FileQueryInfoFlags]
flags cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 "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.MethodInfo FileEnumerateChildrenMethodInfo a signature where
    overloadedMethod = 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 :: a
-> Text
-> [FileQueryInfoFlags]
-> Int32
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
fileEnumerateChildrenAsync file :: a
file attributes :: Text
attributes flags :: [FileQueryInfoFlags]
flags ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileEnumerateChildrenAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m FileEnumerator
fileEnumerateChildrenFinish file :: a
file res :: 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 "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.MethodInfo FileEnumerateChildrenFinishMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m Bool
fileEqual file1 :: a
file1 file2 :: 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
/= 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.MethodInfo FileEqualMethodInfo a signature where
    overloadedMethod = 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'.
-- 
-- If the t'GI.Gio.Structs.FileIface.FileIface' for /@file@/ does not have a mount (e.g.
-- possibly a remote share), /@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 :: a -> Maybe b -> m Mount
fileFindEnclosingMount file :: a
file cancellable :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 "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.MethodInfo FileFindEnclosingMountMethodInfo a signature where
    overloadedMethod = 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 :: a -> Int32 -> Maybe b -> Maybe AsyncReadyCallback -> m ()
fileFindEnclosingMountAsync file :: a
file ioPriority :: Int32
ioPriority cancellable :: Maybe b
cancellable callback :: 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
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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
        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 jCallback :: 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.MethodInfo FileFindEnclosingMountAsyncMethodInfo a signature where
    overloadedMethod = 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 :: a -> b -> m Mount
fileFindEnclosingMountFinish file :: a
file res :: 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 "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.MethodInfo FileFindEnclosingMountFinishMethodInfo a signature where
    overloadedMethod = 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 :: a -> m (Maybe [Char])
fileGetBasename file :: 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
$ \result' :: 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.MethodInfo FileGetBasenameMethodInfo a signature where
    overloadedMethod = 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 :: a -> [Char] -> m File
fileGetChild file :: a
file name :: [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 "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.MethodInfo FileGetChildMethodInfo a signature where
    overloadedMethod = 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 :: a -> Text -> m File
fileGetChildForDisplayName file :: a
file displayName :: 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 "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.MethodInfo FileGetChildForDisplayNameMethodInfo a signature where
    overloadedMethod = 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 :: a -> m (Maybe File)
fileGetParent file :: 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
$ \result' :: 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.MethodInfo FileGetParentMethodInfo a signature where
    overloadedMethod = 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 :: a -> m Text
fileGetParseName file :: 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 "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.MethodInfo FileGetParseNameMethodInfo a signature where
    overloadedMethod = 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 :: a -> m (Maybe [Char])
fileGetPath file :: 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
$ \result' :: 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.MethodInfo FileGetPathMethodInfo a signature where
    overloadedMethod = 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 }
--           , argSco