stuff to add to FilePath or System.directory?

Krasimir Angelov ka2_mail at yahoo.com
Mon Jan 10 04:02:40 EST 2005


   I would like to have these functions in
System.Directory. Just some notes:

   - createDirectoryIfNotExists seems to be better
name for createIfNotExists. This makes clear that the
function creates directory. Since createIfNotExists
creates the parents only it is explicitly specified
createDirectoryAndParents doesn't sound very well for
me.
   - For the same reasons removeDirectoryRecursive
seems to be better name for removeFileRecursive.
   - . and .. are special directories under all
platforms so I think currentDir function is not
necessary. I often use expressions like 

(x /= "." && x /= "..")

It could be usefull to have this function in
System.FilePath. Do you have any proposal for a name
for such function?

Cheers,
  Krasimir

--- Isaac Jones <ijones at syntaxpolice.org> wrote:

> Here's some stuff that I have in the cabal Utils
> module that might be
> useful in System.FilePath or System.Directory...
> 
> What would folks think of adding them? I find
> createIfNotExists to be
> especially useful, though maybe it should be
> createDirectoryAndParents
> or something.
> 
> peace,
> 
>   isaac
> 
>
------------------------------------------------------------
> 
> 
> module PathStuff (createIfNotExists, currentDir,
> removeFileRecursive) where
> 
> import Control.Monad    (unless, liftM, mapM)
> import Data.Maybe       (Maybe, catMaybes)
> import System.IO.Error  (try)
> import System.FilePath  (pathParents)
> import System.Directory (getDirectoryContents,
> removeDirectory,
>                          setCurrentDirectory,
> getCurrentDirectory,
>                          doesDirectoryExist,
> removeFile, 
>                          createDirectory)
> 
> createIfNotExists :: Bool     -- ^Create its parents
> too?
> 		  -> FilePath -- ^The path to the directory you
> want to make
> 		  -> IO ()
> createIfNotExists parents file
>     = do b <- doesDirectoryExist file
> 	 case (b,parents, file) of 
> 		  (_, _, "")    -> return ()
> 		  (True, _, _)  -> return ()
> 		  (_, True, _)  -> createDirectoryParents file
> 		  (_, False, _) -> createDirectory file
> 
> -- |like mkdir -p.  Create this directory and its
> parents
> createDirectoryParents :: FilePath -> IO()
> createDirectoryParents file
>     = mapM_ (createIfNotExists False) (tail
> (pathParents file))
> 
> -- |The path name that represents the current
> directory.  May be
> -- system-specific.  In Unix, it's "." FIX: What
> about other arches?
> currentDir :: FilePath
> currentDir = "."
> 
> -- |Probably follows symlinks, be careful.
> removeFileRecursive :: FilePath -> IO ()
> removeFileRecursive startLoc
>     = do cont' <- getDirectoryContents startLoc
>          let cont = filter (\x -> x /= "." && x /=
> "..") cont'
>          curDir <- getCurrentDirectory
>          setCurrentDirectory startLoc
>          dirs <- removeFiles cont
>          mapM removeFileRecursive dirs
>          setCurrentDirectory curDir
>          removeDirectory startLoc
> 
> -- |Remove a list of files; if it encounters a
> directory, it doesn't
> -- remove it, but returns it.  Throws everything
> that removeFile
> -- throws unless the file is a directory.
> removeFiles :: [FilePath]    -- ^Files and
> directories to remove
>             -> IO [FilePath]
>             {- ^The ones we were unable to remove
> because they were of
>                 an inappropriate type (directory)
> removeFiles -}
> removeFiles files = liftM catMaybes (mapM rm' files)
>       where
>        rm' :: FilePath -> IO (Maybe FilePath)
>        rm' f = do  temp <- try (removeFile f)
>                    case temp of
>                     Left e  -> do isDir <-
> doesDirectoryExist f
>                                   -- If f is not a
> directory, re-throw the error
>                                   unless isDir $
> ioError e
>                                   return (Just f)
>                     Right _ -> return Nothing
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
> 



		
__________________________________ 
Do you Yahoo!? 
Yahoo! Mail - now with 250MB free storage. Learn more.
http://info.mail.yahoo.com/mail_250


More information about the Libraries mailing list