directory (empty) → 1.0.0.0
raw patch · 7 files changed
+1360/−0 lines, 7 filesdep +basedep +filepathdep +old-timesetup-changed
Dependencies added: base, filepath, old-time
Files
- LICENSE +63/−0
- Setup.hs +6/−0
- System/Directory.hs +1060/−0
- cbits/directory.c +55/−0
- directory.cabal +21/−0
- include/HsDirectory.h +108/−0
- include/HsDirectoryConfig.h +47/−0
+ LICENSE view
@@ -0,0 +1,63 @@+This library (libraries/base) is derived from code from two+sources: ++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++The full text of these licenses is reproduced below. Both of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMainWithHooks defaultUserHooks
+ System/Directory.hs view
@@ -0,0 +1,1060 @@+-----------------------------------------------------------------------------+-- |+-- Module : System.Directory+-- Copyright : (c) The University of Glasgow 2001+-- License : BSD-style (see the file libraries/base/LICENSE)+-- +-- Maintainer : libraries@haskell.org+-- Stability : stable+-- Portability : portable+--+-- System-independent interface to directory manipulation.+--+-----------------------------------------------------------------------------++module System.Directory + ( + -- $intro++ -- * Actions on directories+ createDirectory -- :: FilePath -> IO ()+ , createDirectoryIfMissing -- :: Bool -> FilePath -> IO ()+ , removeDirectory -- :: FilePath -> IO ()+ , removeDirectoryRecursive -- :: FilePath -> IO ()+ , renameDirectory -- :: FilePath -> FilePath -> IO ()++ , getDirectoryContents -- :: FilePath -> IO [FilePath]+ , getCurrentDirectory -- :: IO FilePath+ , setCurrentDirectory -- :: FilePath -> IO ()++ -- * Pre-defined directories+ , getHomeDirectory+ , getAppUserDataDirectory+ , getUserDocumentsDirectory+ , getTemporaryDirectory++ -- * Actions on files+ , removeFile -- :: FilePath -> IO ()+ , renameFile -- :: FilePath -> FilePath -> IO ()+ , copyFile -- :: FilePath -> FilePath -> IO ()+ + , canonicalizePath+ , makeRelativeToCurrentDirectory+ , findExecutable++ -- * Existence tests+ , doesFileExist -- :: FilePath -> IO Bool+ , doesDirectoryExist -- :: FilePath -> IO Bool++ -- * Permissions++ -- $permissions++ , Permissions(+ Permissions,+ readable, -- :: Permissions -> Bool+ writable, -- :: Permissions -> Bool+ executable, -- :: Permissions -> Bool+ searchable -- :: Permissions -> Bool+ )++ , getPermissions -- :: FilePath -> IO Permissions+ , setPermissions -- :: FilePath -> Permissions -> IO ()++ -- * Timestamps++ , getModificationTime -- :: FilePath -> IO ClockTime+ ) where++import Prelude hiding ( catch )++import System.Environment ( getEnv )+import System.FilePath+import System.IO.Error hiding ( catch, try )+import Control.Monad ( when, unless )+import Control.Exception++#ifdef __NHC__+import Directory+import System (system)+#endif /* __NHC__ */++#ifdef __HUGS__+import Hugs.Directory+#endif /* __HUGS__ */++import Foreign+import Foreign.C++{-# CFILES cbits/directory.c #-}++#ifdef __GLASGOW_HASKELL__+import System.Posix.Types+import System.Posix.Internals+import System.Time ( ClockTime(..) )+import System.IO++import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )++{- $intro+A directory contains a series of entries, each of which is a named+reference to a file system object (file, directory etc.). Some+entries may be hidden, inaccessible, or have some administrative+function (e.g. `.' or `..' under POSIX+<http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in +this standard all such entries are considered to form part of the+directory contents. Entries in sub-directories are not, however,+considered to form part of the directory contents.++Each file system object is referenced by a /path/. There is+normally at least one absolute path to each file system object. In+some operating systems, it may also be possible to have paths which+are relative to the current directory.+-}++-----------------------------------------------------------------------------+-- Permissions++{- $permissions++ The 'Permissions' type is used to record whether certain operations are+ permissible on a file\/directory. 'getPermissions' and 'setPermissions'+ get and set these permissions, respectively. Permissions apply both to+ files and directories. For directories, the executable field will be+ 'False', and for files the searchable field will be 'False'. Note that+ directories may be searchable without being readable, if permission has+ been given to use them as part of a path, but not to examine the + directory contents.++Note that to change some, but not all permissions, a construct on the following lines must be used. ++> makeReadable f = do+> p <- getPermissions f+> setPermissions f (p {readable = True})++-}++data Permissions+ = Permissions {+ readable, writable, + executable, searchable :: Bool + } deriving (Eq, Ord, Read, Show)++{- |The 'getPermissions' operation returns the+permissions for the file or directory.++The operation may fail with:++* 'isPermissionError' if the user is not permitted to access+ the permissions; or++* 'isDoesNotExistError' if the file or directory does not exist.++-}++getPermissions :: FilePath -> IO Permissions+getPermissions name = do+ withCString name $ \s -> do+#ifdef mingw32_HOST_OS+ -- stat() does a better job of guessing the permissions on Windows+ -- than access() does. e.g. for execute permission, it looks at the+ -- filename extension :-)+ --+ -- I tried for a while to do this properly, using the Windows security API,+ -- and eventually gave up. getPermissions is a flawed API anyway. -- SimonM+ allocaBytes sizeof_stat $ \ p_stat -> do+ throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat+ mode <- st_mode p_stat+ let read = mode .&. s_IRUSR+ let write = mode .&. s_IWUSR+ let exec = mode .&. s_IXUSR+ let is_dir = mode .&. s_IFDIR+ return (+ Permissions {+ readable = read /= 0,+ writable = write /= 0,+ executable = is_dir == 0 && exec /= 0,+ searchable = is_dir /= 0 && exec /= 0+ }+ )+#else+ read <- c_access s r_OK+ write <- c_access s w_OK+ exec <- c_access s x_OK+ withFileStatus "getPermissions" name $ \st -> do+ is_dir <- isDirectory st+ return (+ Permissions {+ readable = read == 0,+ writable = write == 0,+ executable = not is_dir && exec == 0,+ searchable = is_dir && exec == 0+ }+ )+#endif++{- |The 'setPermissions' operation sets the+permissions for the file or directory.++The operation may fail with:++* 'isPermissionError' if the user is not permitted to set+ the permissions; or++* 'isDoesNotExistError' if the file or directory does not exist.++-}++setPermissions :: FilePath -> Permissions -> IO ()+setPermissions name (Permissions r w e s) = do+ allocaBytes sizeof_stat $ \ p_stat -> do+ withCString name $ \p_name -> do+ throwErrnoIfMinus1_ "setPermissions" $ do+ c_stat p_name p_stat+ mode <- st_mode p_stat+ let mode1 = modifyBit r mode s_IRUSR+ let mode2 = modifyBit w mode1 s_IWUSR+ let mode3 = modifyBit (e || s) mode2 s_IXUSR+ c_chmod p_name mode3++ where+ modifyBit :: Bool -> CMode -> CMode -> CMode+ modifyBit False m b = m .&. (complement b)+ modifyBit True m b = m .|. b+++copyPermissions :: FilePath -> FilePath -> IO ()+copyPermissions source dest = do+ allocaBytes sizeof_stat $ \ p_stat -> do+ withCString source $ \p_source -> do+ withCString dest $ \p_dest -> do+ throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat+ mode <- st_mode p_stat+ throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode++-----------------------------------------------------------------------------+-- Implementation++{- |@'createDirectory' dir@ creates a new directory @dir@ which is+initially empty, or as near to empty as the operating system+allows.++The operation may fail with:++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES]@++* 'isAlreadyExistsError' \/ 'AlreadyExists'+The operand refers to a directory that already exists. +@ [EEXIST]@++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'InvalidArgument'+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'NoSuchThing'+There is no path to the directory. +@[ENOENT, ENOTDIR]@++* 'ResourceExhausted'+Insufficient resources (virtual memory, process file descriptors,+physical disk space, etc.) are available to perform the operation.+@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* 'InappropriateType'+The path refers to an existing non-directory object.+@[EEXIST]@++-}++createDirectory :: FilePath -> IO ()+createDirectory path = do+ modifyIOError (`ioeSetFileName` path) $+ withCString path $ \s -> do+ throwErrnoIfMinus1Retry_ "createDirectory" $+ mkdir s 0o777++#else /* !__GLASGOW_HASKELL__ */++copyPermissions :: FilePath -> FilePath -> IO ()+copyPermissions fromFPath toFPath+ = getPermissions fromFPath >>= setPermissions toFPath++#endif++-- | @'createDirectoryIfMissing' parents dir@ creates a new directory +-- @dir@ if it doesn\'t exist. If the first argument is 'True'+-- the function will also create all parent directories if they are missing.+createDirectoryIfMissing :: Bool -- ^ Create its parents too?+ -> FilePath -- ^ The path to the directory you want to make+ -> IO ()+createDirectoryIfMissing parents file = do+ b <- doesDirectoryExist file+ case (b,parents, file) of+ (_, _, "") -> return ()+ (True, _, _) -> return ()+ (_, True, _) -> mapM_ (createDirectoryIfMissing False) $ mkParents file+ (_, False, _) -> createDirectory file+ where mkParents = scanl1 (</>) . splitDirectories . normalise++#if __GLASGOW_HASKELL__+{- | @'removeDirectory' dir@ removes an existing directory /dir/. The+implementation may specify additional constraints which must be+satisfied before a directory can be removed (e.g. the directory has to+be empty, or may not be in use by other processes). It is not legal+for an implementation to partially remove a directory unless the+entire directory is removed. A conformant implementation need not+support directory removal in all situations (e.g. removal of the root+directory).++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+EIO++* 'InvalidArgument'+The operand is not a valid directory name.+[ENAMETOOLONG, ELOOP]++* 'isDoesNotExistError' \/ 'NoSuchThing'+The directory does not exist. +@[ENOENT, ENOTDIR]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'UnsatisfiedConstraints'+Implementation-dependent constraints are not satisfied. +@[EBUSY, ENOTEMPTY, EEXIST]@++* 'UnsupportedOperation'+The implementation does not support removal in this situation.+@[EINVAL]@++* 'InappropriateType'+The operand refers to an existing non-directory object.+@[ENOTDIR]@++-}++removeDirectory :: FilePath -> IO ()+removeDirectory path = do+ modifyIOError (`ioeSetFileName` path) $+ withCString path $ \s ->+ throwErrnoIfMinus1Retry_ "removeDirectory" (c_rmdir s)+#endif++-- | @'removeDirectoryRecursive' dir@ removes an existing directory /dir/+-- together with its content and all subdirectories. Be careful, +-- if the directory contains symlinks, the function will follow them.+removeDirectoryRecursive :: FilePath -> IO ()+removeDirectoryRecursive startLoc = do+ cont <- getDirectoryContents startLoc+ sequence_ [rm (startLoc </> x) | x <- cont, x /= "." && x /= ".."]+ removeDirectory startLoc+ where+ rm :: FilePath -> IO ()+ 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 $ throw e+ removeDirectoryRecursive f+ Right _ -> return ()++#if __GLASGOW_HASKELL__+{- |'removeFile' /file/ removes the directory entry for an existing file+/file/, where /file/ is not itself a directory. The+implementation may specify additional constraints which must be+satisfied before a file can be removed (e.g. the file may not be in+use by other processes).++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'InvalidArgument'+The operand is not a valid file name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError' \/ 'NoSuchThing'+The file does not exist. +@[ENOENT, ENOTDIR]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'UnsatisfiedConstraints'+Implementation-dependent constraints are not satisfied. +@[EBUSY]@++* 'InappropriateType'+The operand refers to an existing directory.+@[EPERM, EINVAL]@++-}++removeFile :: FilePath -> IO ()+removeFile path = do+ modifyIOError (`ioeSetFileName` path) $+ withCString path $ \s ->+ throwErrnoIfMinus1Retry_ "removeFile" (c_unlink s)++{- |@'renameDirectory' old new@ changes the name of an existing+directory from /old/ to /new/. If the /new/ directory+already exists, it is atomically replaced by the /old/ directory.+If the /new/ directory is neither the /old/ directory nor an+alias of the /old/ directory, it is removed as if by+'removeDirectory'. A conformant implementation need not support+renaming directories in all situations (e.g. renaming to an existing+directory, or across different physical devices), but the constraints+must be documented.++On Win32 platforms, @renameDirectory@ fails if the /new/ directory already+exists.++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'InvalidArgument'+Either operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError' \/ 'NoSuchThing'+The original directory does not exist, or there is no path to the target.+@[ENOENT, ENOTDIR]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'ResourceExhausted'+Insufficient resources are available to perform the operation. +@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* 'UnsatisfiedConstraints'+Implementation-dependent constraints are not satisfied.+@[EBUSY, ENOTEMPTY, EEXIST]@++* 'UnsupportedOperation'+The implementation does not support renaming in this situation.+@[EINVAL, EXDEV]@++* 'InappropriateType'+Either path refers to an existing non-directory object.+@[ENOTDIR, EISDIR]@++-}++renameDirectory :: FilePath -> FilePath -> IO ()+renameDirectory opath npath =+ withFileStatus "renameDirectory" opath $ \st -> do+ is_dir <- isDirectory st+ if (not is_dir)+ then ioException (IOError Nothing InappropriateType "renameDirectory"+ ("not a directory") (Just opath))+ else do++ withCString opath $ \s1 ->+ withCString npath $ \s2 ->+ throwErrnoIfMinus1Retry_ "renameDirectory" (c_rename s1 s2)++{- |@'renameFile' old new@ changes the name of an existing file system+object from /old/ to /new/. If the /new/ object already+exists, it is atomically replaced by the /old/ object. Neither+path may refer to an existing directory. A conformant implementation+need not support renaming files in all situations (e.g. renaming+across different physical devices), but the constraints must be+documented.++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'InvalidArgument'+Either operand is not a valid file name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError' \/ 'NoSuchThing'+The original file does not exist, or there is no path to the target.+@[ENOENT, ENOTDIR]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EROFS, EACCES, EPERM]@++* 'ResourceExhausted'+Insufficient resources are available to perform the operation. +@[EDQUOT, ENOSPC, ENOMEM, EMLINK]@++* 'UnsatisfiedConstraints'+Implementation-dependent constraints are not satisfied.+@[EBUSY]@++* 'UnsupportedOperation'+The implementation does not support renaming in this situation.+@[EXDEV]@++* 'InappropriateType'+Either path refers to an existing directory.+@[ENOTDIR, EISDIR, EINVAL, EEXIST, ENOTEMPTY]@++-}++renameFile :: FilePath -> FilePath -> IO ()+renameFile opath npath =+ withFileOrSymlinkStatus "renameFile" opath $ \st -> do+ is_dir <- isDirectory st+ if is_dir+ then ioException (IOError Nothing InappropriateType "renameFile"+ "is a directory" (Just opath))+ else do++ withCString opath $ \s1 ->+ withCString npath $ \s2 ->+ throwErrnoIfMinus1Retry_ "renameFile" (c_rename s1 s2)++#endif /* __GLASGOW_HASKELL__ */++{- |@'copyFile' old new@ copies the existing file from /old/ to /new/.+If the /new/ file already exists, it is atomically replaced by the /old/ file.+Neither path may refer to an existing directory. The permissions of /old/ are+copied to /new/, if possible.+-}++copyFile :: FilePath -> FilePath -> IO ()+#ifdef __NHC__+copyFile fromFPath toFPath =+ do readFile fromFPath >>= writeFile toFPath+ try (copyPermissions fromFPath toFPath)+ return ()+#else+copyFile fromFPath toFPath =+ copy `catch` (\e -> case e of+ IOException e ->+ throw $ IOException $ ioeSetLocation e "copyFile"+ _ -> throw e)+ where copy = bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->+ bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->+ do allocaBytes bufferSize $ copyContents hFrom hTmp+ hClose hTmp+ try (copyPermissions fromFPath tmpFPath)+ renameFile tmpFPath toFPath+ openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"+ cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp+ try $ removeFile tmpFPath+ bufferSize = 1024++ copyContents hFrom hTo buffer = do+ count <- hGetBuf hFrom buffer bufferSize+ when (count > 0) $ do+ hPutBuf hTo buffer count+ copyContents hFrom hTo buffer+#endif++-- | Given path referring to a file or directory, returns a+-- canonicalized path, with the intent that two paths referring+-- to the same file\/directory will map to the same canonicalized+-- path. Note that it is impossible to guarantee that the+-- implication (same file\/dir \<=\> same canonicalizedPath) holds+-- in either direction: this function can make only a best-effort+-- attempt.+canonicalizePath :: FilePath -> IO FilePath+canonicalizePath fpath =+ withCString fpath $ \pInPath ->+ allocaBytes long_path_size $ \pOutPath ->+#if defined(mingw32_HOST_OS)+ alloca $ \ppFilePart ->+ do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart+#else+ do c_realpath pInPath pOutPath+#endif+ peekCString pOutPath++#if defined(mingw32_HOST_OS)+foreign import stdcall unsafe "GetFullPathNameA"+ c_GetFullPathName :: CString+ -> CInt+ -> CString+ -> Ptr CString+ -> IO CInt+#else+foreign import ccall unsafe "realpath"+ c_realpath :: CString+ -> CString+ -> IO CString+#endif++-- | 'makeRelative' the current directory.+makeRelativeToCurrentDirectory :: FilePath -> IO FilePath+makeRelativeToCurrentDirectory x = do+ cur <- getCurrentDirectory+ return $ makeRelative cur x++-- | Given an executable file name, searches for such file+-- in the directories listed in system PATH. The returned value +-- is the path to the found executable or Nothing if there isn't+-- such executable. For example (findExecutable \"ghc\")+-- gives you the path to GHC.+findExecutable :: String -> IO (Maybe FilePath)+findExecutable binary =+#if defined(mingw32_HOST_OS)+ withCString binary $ \c_binary ->+ withCString ('.':exeExtension) $ \c_ext ->+ allocaBytes long_path_size $ \pOutPath ->+ alloca $ \ppFilePart -> do+ res <- c_SearchPath nullPtr c_binary c_ext (fromIntegral long_path_size) pOutPath ppFilePart+ if res > 0 && res < fromIntegral long_path_size+ then do fpath <- peekCString pOutPath+ return (Just fpath)+ else return Nothing++foreign import stdcall unsafe "SearchPathA"+ c_SearchPath :: CString+ -> CString+ -> CString+ -> CInt+ -> CString+ -> Ptr CString+ -> IO CInt+#else+ do+ path <- getEnv "PATH"+ search (splitSearchPath path)+ where+ fileName = binary <.> exeExtension++ search :: [FilePath] -> IO (Maybe FilePath)+ search [] = return Nothing+ search (d:ds) = do+ let path = d </> fileName+ b <- doesFileExist path+ if b then return (Just path)+ else search ds+#endif+++#ifdef __GLASGOW_HASKELL__+{- |@'getDirectoryContents' dir@ returns a list of /all/ entries+in /dir/. ++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'InvalidArgument'+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError' \/ 'NoSuchThing'+The directory does not exist.+@[ENOENT, ENOTDIR]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EACCES]@++* 'ResourceExhausted'+Insufficient resources are available to perform the operation.+@[EMFILE, ENFILE]@++* 'InappropriateType'+The path refers to an existing non-directory object.+@[ENOTDIR]@++-}++getDirectoryContents :: FilePath -> IO [FilePath]+getDirectoryContents path = do+ modifyIOError (`ioeSetFileName` path) $+ alloca $ \ ptr_dEnt ->+ bracket+ (withCString path $ \s -> + throwErrnoIfNullRetry desc (c_opendir s))+ (\p -> throwErrnoIfMinus1_ desc (c_closedir p))+ (\p -> loop ptr_dEnt p)+ where+ desc = "getDirectoryContents"++ loop :: Ptr (Ptr CDirent) -> Ptr CDir -> IO [String]+ loop ptr_dEnt dir = do+ resetErrno+ r <- readdir dir ptr_dEnt+ if (r == 0)+ then do+ dEnt <- peek ptr_dEnt+ if (dEnt == nullPtr)+ then return []+ else do+ entry <- (d_name dEnt >>= peekCString)+ freeDirEnt dEnt+ entries <- loop ptr_dEnt dir+ return (entry:entries)+ else do errno <- getErrno+ if (errno == eINTR) then loop ptr_dEnt dir else do+ let (Errno eo) = errno+ if (eo == end_of_dir)+ then return []+ else throwErrno desc++++{- |If the operating system has a notion of current directories,+'getCurrentDirectory' returns an absolute path to the+current directory of the calling process.++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'isDoesNotExistError' \/ 'NoSuchThing'+There is no path referring to the current directory.+@[EPERM, ENOENT, ESTALE...]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EACCES]@++* 'ResourceExhausted'+Insufficient resources are available to perform the operation.++* 'UnsupportedOperation'+The operating system has no notion of current directory.++-}++getCurrentDirectory :: IO FilePath+getCurrentDirectory = do+ p <- mallocBytes long_path_size+ go p long_path_size+ where go p bytes = do+ p' <- c_getcwd p (fromIntegral bytes)+ if p' /= nullPtr + then do s <- peekCString p'+ free p'+ return s+ else do errno <- getErrno+ if errno == eRANGE+ then do let bytes' = bytes * 2+ p' <- reallocBytes p bytes'+ go p' bytes'+ else throwErrno "getCurrentDirectory"++{- |If the operating system has a notion of current directories,+@'setCurrentDirectory' dir@ changes the current+directory of the calling process to /dir/.++The operation may fail with:++* 'HardwareFault'+A physical I\/O error has occurred.+@[EIO]@++* 'InvalidArgument'+The operand is not a valid directory name.+@[ENAMETOOLONG, ELOOP]@++* 'isDoesNotExistError' \/ 'NoSuchThing'+The directory does not exist.+@[ENOENT, ENOTDIR]@++* 'isPermissionError' \/ 'PermissionDenied'+The process has insufficient privileges to perform the operation.+@[EACCES]@++* 'UnsupportedOperation'+The operating system has no notion of current directory, or the+current directory cannot be dynamically changed.++* 'InappropriateType'+The path refers to an existing non-directory object.+@[ENOTDIR]@++-}++setCurrentDirectory :: FilePath -> IO ()+setCurrentDirectory path = do+ modifyIOError (`ioeSetFileName` path) $+ withCString path $ \s -> + throwErrnoIfMinus1Retry_ "setCurrentDirectory" (c_chdir s)+ -- ToDo: add path to error++{- |The operation 'doesDirectoryExist' returns 'True' if the argument file+exists and is a directory, and 'False' otherwise.+-}++doesDirectoryExist :: FilePath -> IO Bool+doesDirectoryExist name = + catch+ (withFileStatus "doesDirectoryExist" name $ \st -> isDirectory st)+ (\ _ -> return False)++{- |The operation 'doesFileExist' returns 'True'+if the argument file exists and is not a directory, and 'False' otherwise.+-}++doesFileExist :: FilePath -> IO Bool+doesFileExist name = do + catch+ (withFileStatus "doesFileExist" name $ \st -> do b <- isDirectory st; return (not b))+ (\ _ -> return False)++{- |The 'getModificationTime' operation returns the+clock time at which the file or directory was last modified.++The operation may fail with:++* 'isPermissionError' if the user is not permitted to access+ the modification time; or++* 'isDoesNotExistError' if the file or directory does not exist.++-}++getModificationTime :: FilePath -> IO ClockTime+getModificationTime name =+ withFileStatus "getModificationTime" name $ \ st ->+ modificationTime st++withFileStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a+withFileStatus loc name f = do+ modifyIOError (`ioeSetFileName` name) $+ allocaBytes sizeof_stat $ \p ->+ withCString (fileNameEndClean name) $ \s -> do+ throwErrnoIfMinus1Retry_ loc (c_stat s p)+ f p++withFileOrSymlinkStatus :: String -> FilePath -> (Ptr CStat -> IO a) -> IO a+withFileOrSymlinkStatus loc name f = do+ modifyIOError (`ioeSetFileName` name) $+ allocaBytes sizeof_stat $ \p ->+ withCString name $ \s -> do+ throwErrnoIfMinus1Retry_ loc (lstat s p)+ f p++modificationTime :: Ptr CStat -> IO ClockTime+modificationTime stat = do+ mtime <- st_mtime stat+ let realToInteger = round . realToFrac :: Real a => a -> Integer+ return (TOD (realToInteger (mtime :: CTime)) 0)+ +isDirectory :: Ptr CStat -> IO Bool+isDirectory stat = do+ mode <- st_mode stat+ return (s_isdir mode)++fileNameEndClean :: String -> String+fileNameEndClean name = if isDrive name then addTrailingPathSeparator name+ else dropTrailingPathSeparator name++foreign import ccall unsafe "__hscore_R_OK" r_OK :: CInt+foreign import ccall unsafe "__hscore_W_OK" w_OK :: CInt+foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt++foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode+foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode+foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode+foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode++foreign import ccall unsafe "__hscore_long_path_size"+ long_path_size :: Int++#else+long_path_size :: Int+long_path_size = 2048 -- // guess?++#endif /* __GLASGOW_HASKELL__ */++{- | Returns the current user's home directory.++The directory returned is expected to be writable by the current user,+but note that it isn't generally considered good practice to store+application-specific data here; use 'getAppUserDataDirectory'+instead.++On Unix, 'getHomeDirectory' returns the value of the @HOME@+environment variable. On Windows, the system is queried for a+suitable path; a typical path might be +@C:/Documents And Settings/user@.++The operation may fail with:++* 'UnsupportedOperation'+The operating system has no notion of home directory.++* 'isDoesNotExistError'+The home directory for the current user does not exist, or+cannot be found.+-}+getHomeDirectory :: IO FilePath+getHomeDirectory =+#if defined(mingw32_HOST_OS)+ allocaBytes long_path_size $ \pPath -> do+ r <- c_SHGetFolderPath nullPtr csidl_PROFILE nullPtr 0 pPath+ if (r < 0)+ then do+ r <- c_SHGetFolderPath nullPtr csidl_WINDOWS nullPtr 0 pPath+ when (r < 0) (raiseUnsupported "System.Directory.getHomeDirectory")+ else return ()+ peekCString pPath+#else+ getEnv "HOME"+#endif++{- | Returns the pathname of a directory in which application-specific+data for the current user can be stored. The result of+'getAppUserDataDirectory' for a given application is specific to+the current user.++The argument should be the name of the application, which will be used+to construct the pathname (so avoid using unusual characters that+might result in an invalid pathname).++Note: the directory may not actually exist, and may need to be created+first. It is expected that the parent directory exists and is+writable.++On Unix, this function returns @$HOME\/.appName@. On Windows, a+typical path might be ++> C:/Documents And Settings/user/Application Data/appName++The operation may fail with:++* 'UnsupportedOperation'+The operating system has no notion of application-specific data directory.++* 'isDoesNotExistError'+The home directory for the current user does not exist, or+cannot be found.+-}+getAppUserDataDirectory :: String -> IO FilePath+getAppUserDataDirectory appName = do+#if defined(mingw32_HOST_OS)+ allocaBytes long_path_size $ \pPath -> do+ r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath+ when (r<0) (raiseUnsupported "System.Directory.getAppUserDataDirectory")+ s <- peekCString pPath+ return (s++'\\':appName)+#else+ path <- getEnv "HOME"+ return (path++'/':'.':appName)+#endif++{- | Returns the current user's document directory.++The directory returned is expected to be writable by the current user,+but note that it isn't generally considered good practice to store+application-specific data here; use 'getAppUserDataDirectory'+instead.++On Unix, 'getUserDocumentsDirectory' returns the value of the @HOME@+environment variable. On Windows, the system is queried for a+suitable path; a typical path might be +@C:\/Documents and Settings\/user\/My Documents@.++The operation may fail with:++* 'UnsupportedOperation'+The operating system has no notion of document directory.++* 'isDoesNotExistError'+The document directory for the current user does not exist, or+cannot be found.+-}+getUserDocumentsDirectory :: IO FilePath+getUserDocumentsDirectory = do+#if defined(mingw32_HOST_OS)+ allocaBytes long_path_size $ \pPath -> do+ r <- c_SHGetFolderPath nullPtr csidl_PERSONAL nullPtr 0 pPath+ when (r<0) (raiseUnsupported "System.Directory.getUserDocumentsDirectory")+ peekCString pPath+#else+ getEnv "HOME"+#endif++{- | Returns the current directory for temporary files.++On Unix, 'getTemporaryDirectory' returns the value of the @TMPDIR@+environment variable or \"\/tmp\" if the variable isn\'t defined.+On Windows, the function checks for the existence of environment variables in +the following order and uses the first path found:++* +TMP environment variable. ++*+TEMP environment variable. ++*+USERPROFILE environment variable. ++*+The Windows directory++The operation may fail with:++* 'UnsupportedOperation'+The operating system has no notion of temporary directory.++The function doesn\'t verify whether the path exists.+-}+getTemporaryDirectory :: IO FilePath+getTemporaryDirectory = do+#if defined(mingw32_HOST_OS)+ allocaBytes long_path_size $ \pPath -> do+ r <- c_GetTempPath (fromIntegral long_path_size) pPath+ peekCString pPath+#else+ catch (getEnv "TMPDIR") (\ex -> return "/tmp")+#endif++#if defined(mingw32_HOST_OS)+foreign import ccall unsafe "__hscore_getFolderPath"+ c_SHGetFolderPath :: Ptr () + -> CInt + -> Ptr () + -> CInt + -> CString + -> IO CInt+foreign import ccall unsafe "__hscore_CSIDL_PROFILE" csidl_PROFILE :: CInt+foreign import ccall unsafe "__hscore_CSIDL_APPDATA" csidl_APPDATA :: CInt+foreign import ccall unsafe "__hscore_CSIDL_WINDOWS" csidl_WINDOWS :: CInt+foreign import ccall unsafe "__hscore_CSIDL_PERSONAL" csidl_PERSONAL :: CInt++foreign import stdcall unsafe "GetTempPathA" c_GetTempPath :: CInt -> CString -> IO CInt++raiseUnsupported loc = + ioException (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)++#endif++-- ToDo: This should be determined via autoconf (AC_EXEEXT)+-- | Extension for executable files+-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)+exeExtension :: String+#ifdef mingw32_HOST_OS+exeExtension = "exe"+#else+exeExtension = ""+#endif+
+ cbits/directory.c view
@@ -0,0 +1,55 @@+#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)+/* + * (c) The University of Glasgow 2002+ *+ */++#define INLINE+#include "HsDirectory.h"++/*+ * Function: __hscore_getFolderPath()+ *+ * Late-bound version of SHGetFolderPath(), coping with OS versions+ * that have shell32's lacking that particular API.+ *+ */+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+typedef HRESULT (*HSCORE_GETAPPFOLDERFUNTY)(HWND,int,HANDLE,DWORD,char*);+int+__hscore_getFolderPath(HWND hwndOwner,+ int nFolder,+ HANDLE hToken,+ DWORD dwFlags,+ char* pszPath)+{+ static int loaded_dll = 0;+ static HMODULE hMod = (HMODULE)NULL;+ static HSCORE_GETAPPFOLDERFUNTY funcPtr = NULL;+ /* The DLLs to try loading entry point from */+ char* dlls[] = { "shell32.dll", "shfolder.dll" };+ + if (loaded_dll < 0) {+ return (-1);+ } else if (loaded_dll == 0) {+ int i;+ for(i=0;i < sizeof(dlls); i++) {+ hMod = LoadLibrary(dlls[i]);+ if ( hMod != NULL &&+ (funcPtr = (HSCORE_GETAPPFOLDERFUNTY)GetProcAddress(hMod, "SHGetFolderPathA")) ) {+ loaded_dll = 1;+ break;+ }+ }+ if (loaded_dll == 0) {+ loaded_dll = (-1);+ return (-1);+ }+ }+ /* OK, if we got this far the function has been bound */+ return (int)funcPtr(hwndOwner,nFolder,hToken,dwFlags,pszPath);+ /* ToDo: unload the DLL on shutdown? */+}+#endif /* WIN32 */+#endif /* !__NHC__ */+
+ directory.cabal view
@@ -0,0 +1,21 @@+name: directory+version: 1.0.0.0+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+synopsis: library for directory handling+description:+ This package provides a library for handling directories.+build-type: Configure+exposed-modules:+ System.Directory+c-sources:+ cbits/directory.c+include-dirs: include+includes: HsDirectory.h+install-includes: HsDirectory.h HsDirectoryConfig.h+extensions: CPP, ForeignFunctionInterface+build-depends: base, old-time, filepath+extra-tmp-files:+ config.log config.status autom4te.cache+ include/HsDirectoryConfig.h
+ include/HsDirectory.h view
@@ -0,0 +1,108 @@+/* -----------------------------------------------------------------------------+ *+ * (c) The University of Glasgow 2001-2004+ *+ * Definitions for package `directory' which are visible in Haskell land.+ *+ * ---------------------------------------------------------------------------*/++#ifndef __HSDIRECTORY_H__+#define __HSDIRECTORY_H__++#include "HsDirectoryConfig.h"+// Otherwise these clash with similar definitions from other packages:+#undef PACKAGE_BUGREPORT+#undef PACKAGE_NAME+#undef PACKAGE_STRING+#undef PACKAGE_TARNAME+#undef PACKAGE_VERSION++#if HAVE_SYS_TYPES_H+#include <sys/types.h>+#endif+#if HAVE_UNISTD_H+#include <unistd.h>+#endif+#if HAVE_SYS_STAT_H+#include <sys/stat.h>+#endif++#include "HsFFI.h"++#if defined(__MINGW32__)+#include <shlobj.h>+#endif++#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)+extern int __hscore_getFolderPath(HWND hwndOwner,+ int nFolder,+ HANDLE hToken,+ DWORD dwFlags,+ char* pszPath);+#endif++/* -----------------------------------------------------------------------------+ INLINE functions.++ These functions are given as inlines here for when compiling via C,+ but we also generate static versions into the cbits library for+ when compiling to native code.+ -------------------------------------------------------------------------- */++#ifndef INLINE+# if defined(_MSC_VER)+# define INLINE extern __inline+# else+# define INLINE static inline+# endif+#endif++/* A size that will contain many path names, but not necessarily all+ * (PATH_MAX is not defined on systems with unlimited path length,+ * e.g. the Hurd).+ */+INLINE HsInt __hscore_long_path_size() {+#ifdef PATH_MAX+ return PATH_MAX;+#else+ return 4096;+#endif+}++#ifdef __GLASGOW_HASKELL__+INLINE int __hscore_R_OK() { return R_OK; }+INLINE int __hscore_W_OK() { return W_OK; }+INLINE int __hscore_X_OK() { return X_OK; }++INLINE mode_t __hscore_S_IRUSR() { return S_IRUSR; }+INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; }+INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; }+INLINE mode_t __hscore_S_IFDIR() { return S_IFDIR; }+#endif++#if defined(__MINGW32__)++/* Make sure we've got the reqd CSIDL_ constants in scope;+ * w32api header files are lagging a bit in defining the full set.+ */+#if !defined(CSIDL_APPDATA)+#define CSIDL_APPDATA 0x001a+#endif+#if !defined(CSIDL_PERSONAL)+#define CSIDL_PERSONAL 0x0005+#endif+#if !defined(CSIDL_PROFILE)+#define CSIDL_PROFILE 0x0028+#endif+#if !defined(CSIDL_WINDOWS)+#define CSIDL_WINDOWS 0x0024+#endif++INLINE int __hscore_CSIDL_PROFILE() { return CSIDL_PROFILE; }+INLINE int __hscore_CSIDL_APPDATA() { return CSIDL_APPDATA; }+INLINE int __hscore_CSIDL_WINDOWS() { return CSIDL_WINDOWS; }+INLINE int __hscore_CSIDL_PERSONAL() { return CSIDL_PERSONAL; }+#endif++#endif /* __HSDIRECTORY_H__ */+
+ include/HsDirectoryConfig.h view
@@ -0,0 +1,47 @@+/* include/HsDirectoryConfig.h. Generated from HsDirectoryConfig.h.in by configure. */+/* include/HsDirectoryConfig.h.in. Generated from configure.ac by autoheader. */++/* Define to 1 if you have the <inttypes.h> header file. */+#define HAVE_INTTYPES_H 1++/* Define to 1 if you have the <memory.h> header file. */+#define HAVE_MEMORY_H 1++/* Define to 1 if you have the <stdint.h> header file. */+#define HAVE_STDINT_H 1++/* Define to 1 if you have the <stdlib.h> header file. */+#define HAVE_STDLIB_H 1++/* Define to 1 if you have the <strings.h> header file. */+#define HAVE_STRINGS_H 1++/* Define to 1 if you have the <string.h> header file. */+#define HAVE_STRING_H 1++/* Define to 1 if you have the <sys/stat.h> header file. */+#define HAVE_SYS_STAT_H 1++/* Define to 1 if you have the <sys/types.h> header file. */+#define HAVE_SYS_TYPES_H 1++/* Define to 1 if you have the <unistd.h> header file. */+#define HAVE_UNISTD_H 1++/* Define to the address where bug reports for this package should be sent. */+#define PACKAGE_BUGREPORT "libraries@haskell.org"++/* Define to the full name of this package. */+#define PACKAGE_NAME "Haskell directory package"++/* Define to the full name and version of this package. */+#define PACKAGE_STRING "Haskell directory package 1.0"++/* Define to the one symbol short name of this package. */+#define PACKAGE_TARNAME "directory"++/* Define to the version of this package. */+#define PACKAGE_VERSION "1.0"++/* Define to 1 if you have the ANSI C header files. */+#define STDC_HEADERS 1