module System.Gnome.VFS.Directory (
DirectoryHandle,
DirectoryVisitOptions(..),
DirectoryVisitResult(..),
makeDirectory,
makeDirectoryForURI,
removeDirectory,
removeDirectoryFromURI,
directoryOpen,
directoryOpenFromURI,
directoryReadNext,
directoryClose,
directoryListLoad,
directoryVisit,
directoryVisitURI,
directoryVisitFiles,
directoryVisitFilesAtURI
) where
import Control.Exception ( assert
, bracket )
import Control.Monad ( liftM )
import System.Glib.GList ( GList()
, toGList
, readGList )
import System.Glib.UTFString ( withUTFString
, peekUTFString
, newUTFString )
import System.Glib.FFI
import System.Gnome.VFS.FileInfo
import System.Gnome.VFS.BasicTypes
import System.Gnome.VFS.Marshal
makeDirectory :: TextURI
-> [FilePermissions]
-> IO ()
makeDirectory textURI perm =
let cPerm = cFromFlags perm
in withUTFString textURI $ \cTextURI ->
voidResultMarshal $ gnome_vfs_make_directory cTextURI cPerm
makeDirectoryForURI :: URI
-> [FilePermissions]
-> IO ()
makeDirectoryForURI uri perm =
let cPerm = cFromFlags perm
in voidResultMarshal $ (\(URI arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_make_directory_for_uri argPtr1 arg2) uri cPerm
removeDirectory :: TextURI
-> IO ()
removeDirectory textURI =
withUTFString textURI $ voidResultMarshal . gnome_vfs_remove_directory
removeDirectoryFromURI :: URI
-> IO ()
removeDirectoryFromURI uri =
voidResultMarshal $ (\(URI arg1) -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_remove_directory_from_uri argPtr1) uri
directoryOpen :: TextURI
-> [FileInfoOptions]
-> IO DirectoryHandle
directoryOpen textURI fileInfoOptions =
let cFileInfoOptions = cFromFlags fileInfoOptions
in withUTFString textURI $ \cTextURI ->
newObjectResultMarshal DirectoryHandle $ \cHandlePtr ->
gnome_vfs_directory_open (castPtr cHandlePtr) cTextURI cFileInfoOptions
directoryOpenFromURI :: URI
-> [FileInfoOptions]
-> IO DirectoryHandle
directoryOpenFromURI uri fileInfoOptions =
let cFileInfoOptions = cFromFlags fileInfoOptions
in newObjectResultMarshal DirectoryHandle $ \cHandlePtr ->
(\arg1 (URI arg2) arg3 -> withForeignPtr arg2 $ \argPtr2 ->gnome_vfs_directory_open_from_uri arg1 argPtr2 arg3) (castPtr cHandlePtr) uri cFileInfoOptions
directoryReadNext :: DirectoryHandle
-> IO FileInfo
directoryReadNext handle =
alloca $ \(cFileInfoPtr :: Ptr FileInfo) ->
genericResultMarshal ((\(DirectoryHandle arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_read_next argPtr1 arg2) handle $ castPtr cFileInfoPtr)
(peek cFileInfoPtr)
(return ())
directoryClose :: DirectoryHandle
-> IO ()
directoryClose handle =
voidResultMarshal $ (\(DirectoryHandle arg1) -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_close argPtr1) handle
type CDirectoryVisitFunc = CString
-> Ptr FileInfo
-> (CInt)
-> ((Ptr ()))
-> Ptr (CInt)
-> IO (CInt)
directoryVisitCallbackMarshal :: DirectoryVisitCallback
-> IO ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))))
directoryVisitCallbackMarshal callback =
let cCallback :: CDirectoryVisitFunc
cCallback cRelPath cInfo cRecursingWillLoop cUserData cRecursePtr =
do relPath <- peekUTFString cRelPath
info <- peek cInfo
let recursingWillLoop = toBool cRecursingWillLoop
result <- callback relPath info recursingWillLoop
case result of
DirectoryVisitStop -> return $ fromBool False
DirectoryVisitContinue -> return $ fromBool True
DirectoryVisitRecurse -> do poke cRecursePtr $ fromBool True
return $ fromBool True
in makeDirectoryVisitFunc cCallback
foreign import ccall safe "wrapper"
makeDirectoryVisitFunc :: CDirectoryVisitFunc
-> IO ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))))
type DirectoryVisit = [FileInfoOptions]
-> [DirectoryVisitOptions]
-> DirectoryVisitCallback
-> IO ()
type CDirectoryVisit = (CInt)
-> (CInt)
-> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))))
-> ((Ptr ()))
-> IO (CInt)
directoryVisitMarshal :: CDirectoryVisit
-> DirectoryVisit
directoryVisitMarshal cVisitAction infoOptions visitOptions callback =
let cInfoOptions = cFromFlags infoOptions
cVisitOptions = cFromFlags visitOptions
in bracket (directoryVisitCallbackMarshal callback)
freeHaskellFunPtr
(\cDirectoryVisitFunc ->
voidResultMarshal $ cVisitAction cInfoOptions cVisitOptions cDirectoryVisitFunc nullPtr)
directoryVisit :: String
-> [FileInfoOptions]
-> [DirectoryVisitOptions]
-> DirectoryVisitCallback
-> IO ()
directoryVisit textURI infoOptions visitOptions callback =
withUTFString textURI $ \cTextURI ->
directoryVisitMarshal (gnome_vfs_directory_visit cTextURI) infoOptions visitOptions callback
directoryVisitURI :: URI
-> [FileInfoOptions]
-> [DirectoryVisitOptions]
-> DirectoryVisitCallback
-> IO ()
directoryVisitURI uri =
directoryVisitMarshal ((\(URI arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_visit_uri argPtr1 arg2 arg3 arg4 arg5) uri)
directoryVisitFiles :: TextURI
-> [String]
-> [FileInfoOptions]
-> [DirectoryVisitOptions]
-> DirectoryVisitCallback
-> IO ()
directoryVisitFiles textURI files infoOptions visitOptions callback =
do cFiles <- mapM newUTFString files >>= toGList
withUTFString textURI $ \cTextURI ->
directoryVisitMarshal (gnome_vfs_directory_visit_files cTextURI cFiles) infoOptions visitOptions callback
directoryVisitFilesAtURI :: URI
-> [String]
-> [FileInfoOptions]
-> [DirectoryVisitOptions]
-> DirectoryVisitCallback
-> IO ()
directoryVisitFilesAtURI uri files infoOptions visitOptions callback =
do cFiles <- mapM newUTFString files >>= toGList
directoryVisitMarshal ((\(URI arg1) arg2 arg3 arg4 arg5 arg6 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_visit_files_at_uri argPtr1 arg2 arg3 arg4 arg5 arg6) uri cFiles) infoOptions visitOptions callback
directoryListLoad :: TextURI
-> [FileInfoOptions]
-> IO [FileInfo]
directoryListLoad textURI options =
let cOptions = cFromFlags options
in withUTFString textURI $ \cTextURI ->
alloca $ \cListPtr ->
genericResultMarshal (gnome_vfs_directory_list_load cListPtr cTextURI cOptions)
(peek cListPtr >>= readGList >>= mapM peek)
(do cList <- peek cListPtr
assert (cList == nullPtr) $ return ())
foreign import ccall safe "gnome_vfs_make_directory"
gnome_vfs_make_directory :: ((Ptr CChar) -> (CUInt -> (IO CInt)))
foreign import ccall safe "gnome_vfs_make_directory_for_uri"
gnome_vfs_make_directory_for_uri :: ((Ptr URI) -> (CUInt -> (IO CInt)))
foreign import ccall safe "gnome_vfs_remove_directory"
gnome_vfs_remove_directory :: ((Ptr CChar) -> (IO CInt))
foreign import ccall safe "gnome_vfs_remove_directory_from_uri"
gnome_vfs_remove_directory_from_uri :: ((Ptr URI) -> (IO CInt))
foreign import ccall safe "gnome_vfs_directory_open"
gnome_vfs_directory_open :: ((Ptr DirectoryHandle) -> ((Ptr CChar) -> (CInt -> (IO CInt))))
foreign import ccall safe "gnome_vfs_directory_open_from_uri"
gnome_vfs_directory_open_from_uri :: ((Ptr DirectoryHandle) -> ((Ptr URI) -> (CInt -> (IO CInt))))
foreign import ccall safe "gnome_vfs_directory_read_next"
gnome_vfs_directory_read_next :: ((Ptr DirectoryHandle) -> ((Ptr ()) -> (IO CInt)))
foreign import ccall safe "gnome_vfs_directory_close"
gnome_vfs_directory_close :: ((Ptr DirectoryHandle) -> (IO CInt))
foreign import ccall safe "gnome_vfs_directory_visit"
gnome_vfs_directory_visit :: ((Ptr CChar) -> (CInt -> (CInt -> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))) -> ((Ptr ()) -> (IO CInt))))))
foreign import ccall safe "gnome_vfs_directory_visit_uri"
gnome_vfs_directory_visit_uri :: ((Ptr URI) -> (CInt -> (CInt -> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))) -> ((Ptr ()) -> (IO CInt))))))
foreign import ccall safe "gnome_vfs_directory_visit_files"
gnome_vfs_directory_visit_files :: ((Ptr CChar) -> ((Ptr ()) -> (CInt -> (CInt -> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))) -> ((Ptr ()) -> (IO CInt)))))))
foreign import ccall safe "gnome_vfs_directory_visit_files_at_uri"
gnome_vfs_directory_visit_files_at_uri :: ((Ptr URI) -> ((Ptr ()) -> (CInt -> (CInt -> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))) -> ((Ptr ()) -> (IO CInt)))))))
foreign import ccall safe "gnome_vfs_directory_list_load"
gnome_vfs_directory_list_load :: ((Ptr (Ptr ())) -> ((Ptr CChar) -> (CInt -> (IO CInt))))