gnomevfs-0.11.0: System/Gnome/VFS/Directory.chs
{-# LANGUAGE CPP, ScopedTypeVariables #-}
-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*-
--
-- Author : Peter Gavin
-- Created: 1-Apr-2007
--
-- Copyright (c) 2007 Peter Gavin
--
-- This library is free software: you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public License
-- as published by the Free Software Foundation, either version 3 of
-- the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.
--
-- GnomeVFS, the C library which this Haskell library depends on, is
-- available under LGPL Version 2. The documentation included with
-- this library is based on the original GnomeVFS documentation,
-- Copyright (c) 2001 Seth Nickell <snickell@stanford.edu>. The
-- documentation is covered by the GNU Free Documentation License,
-- version 1.2.
--
-- | Maintainer : gtk2hs-devel@lists.sourceforge.net
-- Stability : alpha
-- Portability : portable (depends on GHC)
--
-- Functions for creating, removing, and accessing directories and
-- their contents.
--
module System.Gnome.VFS.Directory (
-- * Types
DirectoryHandle,
DirectoryVisitOptions(..),
DirectoryVisitResult(..),
-- * Directory Creation
makeDirectory,
makeDirectoryForURI,
-- * Directory Removal
removeDirectory,
removeDirectoryFromURI,
-- * Directory Access
directoryOpen,
directoryOpenFromURI,
directoryReadNext,
directoryClose,
directoryListLoad,
-- * Directory Traversal
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.Types#}
{#import System.Gnome.VFS.BasicTypes#}
{#import System.Gnome.VFS.Marshal#}
{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-- | Create @textURI@ as a directory. Only succeeds if a file or
-- directory does not already exist at @textURI@.
makeDirectory :: TextURI -- ^ @textURI@ - String representation of the URI of the directory to create
-> [FilePermissions] -- ^ @perm@ - 'FilePermissions' for the newly created directory
-> IO ()
makeDirectory textURI perm =
let cPerm = cFromFlags perm
in withUTFString textURI $ \cTextURI ->
voidResultMarshal $ {# call make_directory #} cTextURI cPerm
-- | Create @uri@ as a directory. Only succeeds if a file or
-- directory does not already exist at @uri@.
makeDirectoryForURI :: URI -- ^ @uri@ - 'URI' of the directory to be created
-> [FilePermissions] -- ^ @perm@ - 'FilePermissions' for the newly created directory
-> IO ()
makeDirectoryForURI uri perm =
let cPerm = cFromFlags perm
in voidResultMarshal $ {# call make_directory_for_uri #} uri cPerm
-- | Remove the directory at @textURI@. The object at @textURI@ must be an empty directory.
removeDirectory :: TextURI -- ^ @textURI@ - URI of the directory to be removed
-> IO ()
removeDirectory textURI =
withUTFString textURI $ voidResultMarshal . {# call remove_directory #}
-- | Remove the directory at @uri@. The object at @uri@ must be an empty directory.
removeDirectoryFromURI :: URI -- ^ @uri@ - 'URI' of the directory to be removed
-> IO ()
removeDirectoryFromURI uri =
voidResultMarshal $ {# call remove_directory_from_uri #} uri
-- | Open directory textURI for reading. Returns a 'DirectoryHandle'
-- which can be used to read directory entries one by one.
directoryOpen :: TextURI -- ^ @textURI@ - String representation of the URI of the directory to open
-> [FileInfoOptions] -- ^ @fileInfoOptions@ - options for reading file information
-> IO DirectoryHandle -- ^ handle to the opened directory
directoryOpen textURI fileInfoOptions =
let cFileInfoOptions = cFromFlags fileInfoOptions
in withUTFString textURI $ \cTextURI ->
newObjectResultMarshal DirectoryHandle $ \cHandlePtr ->
{# call directory_open #} (castPtr cHandlePtr) cTextURI cFileInfoOptions
-- | Open directory textURI for reading. Returns a 'DirectoryHandle'
-- which can be used to read directory entries one by one.
directoryOpenFromURI :: URI -- ^ @uri@ - 'URI' of the directory to open
-> [FileInfoOptions] -- ^ @fileInfoOptions@ - options for reading file information
-> IO DirectoryHandle -- ^ handle to the opened directory
directoryOpenFromURI uri fileInfoOptions =
let cFileInfoOptions = cFromFlags fileInfoOptions
in newObjectResultMarshal DirectoryHandle $ \cHandlePtr ->
{# call directory_open_from_uri #} (castPtr cHandlePtr) uri cFileInfoOptions
-- | Read the next directory entry from a 'DirectoryHandle'.
directoryReadNext :: DirectoryHandle -- ^ @handle@ - a directory handle
-> IO FileInfo -- ^ file information for the next directory entry
directoryReadNext handle =
alloca $ \(cFileInfoPtr :: Ptr FileInfo) ->
genericResultMarshal ({# call directory_read_next #} handle $ castPtr cFileInfoPtr)
(peek cFileInfoPtr)
(return ())
-- | Close a 'DirectoryHandle'.
directoryClose :: DirectoryHandle -- ^ @handle@ - a directory handle
-> IO ()
directoryClose handle =
voidResultMarshal $ {# call directory_close #} handle
type CDirectoryVisitFunc = CString -- rel_path
-> Ptr FileInfo -- info
-> {# type gboolean #} -- recursing_will_loop
-> {# type gpointer #} -- user_data
-> Ptr {# type gboolean #} -- recurse
-> IO {# type gboolean #}
directoryVisitCallbackMarshal :: DirectoryVisitCallback
-> IO {# type GnomeVFSDirectoryVisitFunc #}
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 {# type GnomeVFSDirectoryVisitFunc #}
type DirectoryVisit = [FileInfoOptions]
-> [DirectoryVisitOptions]
-> DirectoryVisitCallback
-> IO ()
type CDirectoryVisit = {# type GnomeVFSFileInfoOptions #}
-> {# type GnomeVFSDirectoryVisitOptions #}
-> {# type GnomeVFSDirectoryVisitFunc #}
-> {# type gpointer #}
-> IO {# type GnomeVFSResult #}
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)
-- | Visit each entry in a directory at a 'TextURI', calling a
-- 'DirectoryVisitCallback' for each one.
directoryVisit :: String -- ^ @textURI@ - string representation of the URI of the directory to visit
-> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information
-> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory
-> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry
-> IO ()
directoryVisit textURI infoOptions visitOptions callback =
withUTFString textURI $ \cTextURI ->
directoryVisitMarshal ({# call directory_visit #} cTextURI) infoOptions visitOptions callback
-- | Visit each entry in a directory at a 'URI', calling a
-- 'DirectoryVisitCallback' for each one.
directoryVisitURI :: URI -- ^ @uri@ - the URI of the directory to visit
-> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information
-> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory
-> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry
-> IO ()
directoryVisitURI uri =
directoryVisitMarshal ({# call directory_visit_uri #} uri)
-- | Visit each file in a list contained with a directory at a
-- 'TextURI', calling a 'DirectoryVisitCallback' for each one.
directoryVisitFiles :: TextURI -- ^ @textURI@ - string representation of the URI of the directory to visit
-> [String] -- ^ @files@ - the files contained in @textURI@ to be visited
-> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information
-> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory
-> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry
-> IO ()
directoryVisitFiles textURI files infoOptions visitOptions callback =
do cFiles <- mapM newUTFString files >>= toGList
withUTFString textURI $ \cTextURI ->
directoryVisitMarshal ({# call directory_visit_files #} cTextURI cFiles) infoOptions visitOptions callback
-- | Visit each file in a list contained with a directory at a
-- 'URI', calling a 'DirectoryVisitCallback' for each one.
directoryVisitFilesAtURI :: URI -- ^ @uri@ - the 'URI' of the directory to visit
-> [String] -- ^ @files@ - the files contained in @textURI@ to be visited
-> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information
-> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory
-> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry
-> IO ()
directoryVisitFilesAtURI uri files infoOptions visitOptions callback =
do cFiles <- mapM newUTFString files >>= toGList
directoryVisitMarshal ({# call directory_visit_files_at_uri #} uri cFiles) infoOptions visitOptions callback
-- | Create a list of 'FileInfo' objects representing each entry in the
-- directory at @textURI@, using options @options@.
directoryListLoad :: TextURI -- ^ @textURI@ - String representation of the URI of the directory to load
-> [FileInfoOptions] -- ^ @options@ - options for reading file information
-> IO [FileInfo] -- ^ the entries contined in the directory
directoryListLoad textURI options =
let cOptions = cFromFlags options
in withUTFString textURI $ \cTextURI ->
alloca $ \cListPtr ->
genericResultMarshal ({# call directory_list_load #} cListPtr cTextURI cOptions)
(peek cListPtr >>= readGList >>= mapM peek)
(do cList <- peek cListPtr
assert (cList == nullPtr) $ return ())