{-# LANGUAGE ScopedTypeVariables #-}

{-# LINE 2 "./System/Gnome/VFS/Directory.chs" #-}
-- 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:
--
-- 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
{-# LINE 78 "./System/Gnome/VFS/Directory.chs" #-}
-- {#import System.Gnome.VFS.Types#}
import System.Gnome.VFS.BasicTypes
{-# LINE 80 "./System/Gnome/VFS/Directory.chs" #-}
import System.Gnome.VFS.Marshal
{-# LINE 81 "./System/Gnome/VFS/Directory.chs" #-}


{-# LINE 83 "./System/Gnome/VFS/Directory.chs" #-}

-- | 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 $ gnome_vfs_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 $ (\(URI arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_make_directory_for_uri argPtr1 arg2) 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 . gnome_vfs_remove_directory
{-# LINE 108 "./System/Gnome/VFS/Directory.chs" #-}

-- | 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 $ (\(URI arg1) -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_remove_directory_from_uri argPtr1) 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 ->
            gnome_vfs_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 ->
        (\arg1 (URI arg2) arg3 -> withForeignPtr arg2 $ \argPtr2 ->gnome_vfs_directory_open_from_uri arg1 argPtr2 arg3) (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 ((\(DirectoryHandle arg1) arg2 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_read_next argPtr1 arg2) handle $ castPtr cFileInfoPtr)
                          (peek cFileInfoPtr)
                          (return ())

-- | Close a 'DirectoryHandle'.
directoryClose :: DirectoryHandle -- ^ @handle@ - a directory handle
               -> IO ()
directoryClose handle =
    voidResultMarshal $ (\(DirectoryHandle arg1) -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_close argPtr1) handle

type CDirectoryVisitFunc = CString -- rel_path
                         -> Ptr FileInfo -- info
                         -> (CInt) -- recursing_will_loop
                         -> ((Ptr ())) -- user_data
                         -> Ptr (CInt) -- recurse
                         -> IO (CInt)
{-# LINE 157 "./System/Gnome/VFS/Directory.chs" #-}
directoryVisitCallbackMarshal :: DirectoryVisitCallback
                              -> IO ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))))
{-# LINE 159 "./System/Gnome/VFS/Directory.chs" #-}
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))))))))
{-# LINE 175 "./System/Gnome/VFS/Directory.chs" #-}

type DirectoryVisit = [FileInfoOptions]
                       -> [DirectoryVisitOptions]
                       -> DirectoryVisitCallback
                       -> IO ()
type CDirectoryVisit = (CInt)
{-# LINE 181 "./System/Gnome/VFS/Directory.chs" #-}
                       -> (CInt)
{-# LINE 182 "./System/Gnome/VFS/Directory.chs" #-}
                       -> ((FunPtr ((Ptr CChar) -> ((Ptr ()) -> (CInt -> ((Ptr ()) -> ((Ptr CInt) -> (IO CInt))))))))
{-# LINE 183 "./System/Gnome/VFS/Directory.chs" #-}
                       -> ((Ptr ()))
{-# LINE 184 "./System/Gnome/VFS/Directory.chs" #-}
                       -> IO (CInt)
{-# LINE 185 "./System/Gnome/VFS/Directory.chs" #-}

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 (gnome_vfs_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 ((\(URI arg1) arg2 arg3 arg4 arg5 -> withForeignPtr arg1 $ \argPtr1 ->gnome_vfs_directory_visit_uri argPtr1 arg2 arg3 arg4 arg5) 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 (gnome_vfs_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 ((\(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

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