easy-file (empty) → 0.1.0
raw patch · 7 files changed
+1325/−0 lines, 7 filesdep +Win32dep +basedep +directorysetup-changed
Dependencies added: Win32, base, directory, filepath, time, unix
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- System/EasyFile.hs +94/−0
- System/EasyFile/Directory.hs +200/−0
- System/EasyFile/FilePath.hs +820/−0
- System/EasyFile/Missing.hs +151/−0
- easy-file.cabal +29/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2009, IIJ Innovation Institute Inc.+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 the name of the copyright holders 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 COPYRIGHT HOLDERS AND 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+COPYRIGHT OWNER OR 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/EasyFile.hs view
@@ -0,0 +1,94 @@+{-|+This is a module of cross-platform file handling for Unix\/Mac\/Windows.++The standard module "System.Directory" and "System.FilePath" have+following shortcomings:++* getModificationTime exists in "System.Directory". But getAccessTime,+ getChangeTime, getCreationTime do not exist.++* getModificationTime returns obsoleted type, 'ClockTime'. It should+ return modern type, 'UTCTime', I believe.++* Some file functions are missing. A function to tell the link counter,+ for instance.++* Path separator is not unified. Even though Windows accepts \'\/\' as a+ file separator, getCurrentDirectory in "System.Directory" returns \'\\\'+ as a file separator. So, we need to specify regular expression like+ this: \"[\/\\\\]foo[\/\\\\]bar[\/\\\\]baz\".++* getHomeDirectory returns @HOMEDRIVE@\/@HOMEPATH@ instead of the @HOME@+ environment variable on Windows.++This module aims to resolve these problems and provides:++* 'getModificationTime', 'getAccessTime', 'getChangeTime', and+ 'getCreationTime'. They return 'UTCTime'.++* 'isSymlink', 'getLinkCount', and 'hasSubDirectories'.++* \'\/\' as the single 'pathSeparator'. For instance,+ 'getCurrentDirectory' returns a path whose separator is \'\/\'+ even on Windows.++* 'getHomeDirectory2' which refers the @HOME@ environment variable.++* Necessary functions in "System.Directory" and "System.FilePath".++This is alpha version. The specification would be changed in the+future. Please send comments to:++@+ <http://github.com/kazu-yamamoto/easy-file/issues>+@+-}++module System.EasyFile (+ -- * Actions on directories+ createDirectory+ , createDirectoryIfMissing+ , removeDirectory+ , removeDirectoryRecursive+ , renameDirectory+ , getDirectoryContents+ , getCurrentDirectory+ , setCurrentDirectory+ -- * Pre-defined directories+ , getHomeDirectory+ , getHomeDirectory2 -- missing+ , getAppUserDataDirectory+ , getUserDocumentsDirectory+ , getTemporaryDirectory+ -- * Actions on files+ , removeFile+ , renameFile+ , copyFile+ , canonicalizePath+-- , makeRelativeToCurrentDirectory -- xxx+-- , findExecutable -- xxx+ -- * Existence tests+ , doesFileExist+ , doesDirectoryExist+ -- * Permissions+ , Permissions(..)+ , getPermissions+ , setPermissions+ , copyPermissions+ -- * Timestamps+ , getCreationTime+ , getChangeTime+ , getModificationTime+ , getAccessTime+ -- * File\/directory information+ , isSymlink+ , getLinkCount+ , hasSubDirectories+ , module System.EasyFile.FilePath+ ) where++----------------------------------------------------------------++import System.EasyFile.Directory+import System.EasyFile.FilePath+import System.EasyFile.Missing
+ System/EasyFile/Directory.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE CPP #-}++module System.EasyFile.Directory (+ module System.EasyFile.Directory+ , module System.Directory+ ) where++import System.Directory (+ createDirectory+ , createDirectoryIfMissing+ , removeDirectory+ , removeDirectoryRecursive+ , renameDirectory+ , getDirectoryContents+ , setCurrentDirectory+ , removeFile+ , renameFile+ , copyFile+ , canonicalizePath+ , doesFileExist+ , doesDirectoryExist+ , Permissions(..)+ , getPermissions+ , setPermissions+ )++import qualified System.Directory as D (+ getCurrentDirectory+ , getHomeDirectory+ , getAppUserDataDirectory+ , getUserDocumentsDirectory+ , getTemporaryDirectory+ , copyPermissions+ )++import Control.Applicative+import System.Environment++----------------------------------------------------------------++{- |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 = fixPath <$> D.getCurrentDirectory++{- | 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 = fixPath <$> D.getHomeDirectory++{- | Returns the current user's home directory from+the @HOME@ environment variable.+-}++getHomeDirectory2 :: IO (Maybe FilePath)+getHomeDirectory2 = (Just . fixPath <$> getEnv "HOME") `catch` \_ -> return Nothing++{- | 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 x = fixPath <$> D.getAppUserDataDirectory x++{- | 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 = fixPath <$> D.getUserDocumentsDirectory++{- | 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 = fixPath <$> D.getTemporaryDirectory++----------------------------------------------------------------++fixPath :: FilePath -> FilePath+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+fixPath [] = []+fixPath (c:cs)+ | c == '\\' = '/' : fixPath cs+ | otherwise = c : fixPath cs+#else+fixPath = id+#endif++----------------------------------------------------------------+-- Just adding documentation.++{-|+ This function copy the permission of the first file to the second.+-}+copyPermissions :: FilePath -> FilePath -> IO ()+copyPermissions = D.copyPermissions
+ System/EasyFile/FilePath.hs view
@@ -0,0 +1,820 @@+{-# LANGUAGE CPP #-}++{-+ This module based on System.FilePath.Internal of file-path.+ The code was copied with the permission from the author+ of file-path, Neil Mitchell. Thanks!+ See the copyright at the end of file.+-}++module System.EasyFile.FilePath (+ -- * Separator predicates+ FilePath,+ pathSeparator, pathSeparators, isPathSeparator,+{- xxx+ searchPathSeparator, isSearchPathSeparator,+-}+ extSeparator, isExtSeparator,++{- xxx+ -- * Path methods (environment $PATH)+ splitSearchPath, getSearchPath,+-}++ -- * Extension methods+ splitExtension,+ takeExtension, replaceExtension, dropExtension, addExtension, hasExtension, (<.>),+ splitExtensions, dropExtensions, takeExtensions,++ -- * Drive methods+ splitDrive, joinDrive,+ takeDrive, hasDrive, dropDrive, isDrive,++ -- * Operations on a FilePath, as a list of directories+ splitFileName,+ takeFileName, replaceFileName, dropFileName,+ takeBaseName, replaceBaseName,+ takeDirectory, replaceDirectory,+ combine, (</>),+ splitPath, joinPath, splitDirectories,++ -- * Low level FilePath operators+ hasTrailingPathSeparator,+ addTrailingPathSeparator,+ dropTrailingPathSeparator,++ -- * File name manipulators+ normalise, equalFilePath,+ makeRelative,+ isRelative, isAbsolute,+{- xxx+ isValid, makeValid+-}++#ifdef TESTING+ , isRelativeDrive+#endif++ )+ where++import Data.Char(toLower, toUpper)+import Data.Maybe(isJust, fromJust)++-- import System.Environment(getEnv) -- xxx+++infixr 7 <.>+infixr 5 </>++++++---------------------------------------------------------------------+-- Platform Abstraction Methods (private)++-- | Is the operating system Unix or Linux like+isPosix :: Bool+isPosix = not isWindows++-- | Is the operating system Windows like+isWindows :: Bool+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+isWindows = True+#else+isWindows = False+#endif++---------------------------------------------------------------------+-- The basic functions++-- | The character that separates directories.+--+-- > pathSeparator == '/'+-- > isPathSeparator pathSeparator+pathSeparator :: Char+pathSeparator = '/'++-- | The list of all possible separators.+--+-- > Windows: pathSeparators == ['\\', '/']+-- > Posix: pathSeparators == ['/']+-- > pathSeparator `elem` pathSeparators+pathSeparators :: [Char]+pathSeparators = if isWindows then "\\/" else "/"++-- | Rather than using @(== 'pathSeparator')@, use this. Test if something+-- is a path separator.+--+-- > isPathSeparator a == (a `elem` pathSeparators)+isPathSeparator :: Char -> Bool+isPathSeparator = (`elem` pathSeparators)+++{- xxx+-- | The character that is used to separate the entries in the $PATH environment variable.+--+-- > Windows: searchPathSeparator == ';'+-- > Posix: searchPathSeparator == ':'+searchPathSeparator :: Char+searchPathSeparator = if isWindows then ';' else ':'++-- | Is the character a file separator?+--+-- > isSearchPathSeparator a == (a == searchPathSeparator)+isSearchPathSeparator :: Char -> Bool+isSearchPathSeparator = (== searchPathSeparator)+-}++-- | File extension character+--+-- > extSeparator == '.'+extSeparator :: Char+extSeparator = '.'++-- | Is the character an extension character?+--+-- > isExtSeparator a == (a == extSeparator)+isExtSeparator :: Char -> Bool+isExtSeparator = (== extSeparator)+++++{- xxx+---------------------------------------------------------------------+-- Path methods (environment $PATH)++-- | Take a string, split it on the 'searchPathSeparator' character.+--+-- Follows the recommendations in+-- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>+--+-- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"]+-- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]+-- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"]+-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]+splitSearchPath :: String -> [FilePath]+splitSearchPath = f+ where+ f xs = case break isSearchPathSeparator xs of+ (pre, [] ) -> g pre+ (pre, _:post) -> g pre ++ f post++ g "" = ["." | isPosix]+ g x = [x]+++-- | Get a list of filepaths in the $PATH.+getSearchPath :: IO [FilePath]+getSearchPath = fmap splitSearchPath (getEnv "PATH")+-}++---------------------------------------------------------------------+-- Extension methods++-- | Split on the extension. 'addExtension' is the inverse.+--+-- > uncurry (++) (splitExtension x) == x+-- > uncurry addExtension (splitExtension x) == x+-- > splitExtension "file.txt" == ("file",".txt")+-- > splitExtension "file" == ("file","")+-- > splitExtension "file/file.txt" == ("file/file",".txt")+-- > splitExtension "file.txt/boris" == ("file.txt/boris","")+-- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")+-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")+-- > splitExtension "file/path.txt/" == ("file/path.txt/","")+splitExtension :: FilePath -> (String, String)+splitExtension x = case d of+ "" -> (x,"")+ (y:ys) -> (a ++ reverse ys, y : reverse c)+ where+ (a,b) = splitFileName x+ (c,d) = break isExtSeparator $ reverse b++-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.+--+-- > takeExtension x == snd (splitExtension x)+-- > Valid x => takeExtension (addExtension x "ext") == ".ext"+-- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"+takeExtension :: FilePath -> String+takeExtension = snd . splitExtension++-- | Set the extension of a file, overwriting one if already present.+--+-- > replaceExtension "file.txt" ".bob" == "file.bob"+-- > replaceExtension "file.txt" "bob" == "file.bob"+-- > replaceExtension "file" ".bob" == "file.bob"+-- > replaceExtension "file.txt" "" == "file"+-- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"+replaceExtension :: FilePath -> String -> FilePath+replaceExtension x y = dropExtension x <.> y++-- | Alias to 'addExtension', for people who like that sort of thing.+(<.>) :: FilePath -> String -> FilePath+(<.>) = addExtension++-- | Remove last extension, and the \".\" preceding it.+--+-- > dropExtension x == fst (splitExtension x)+dropExtension :: FilePath -> FilePath+dropExtension = fst . splitExtension++-- | Add an extension, even if there is already one there.+-- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.+--+-- > addExtension "file.txt" "bib" == "file.txt.bib"+-- > addExtension "file." ".bib" == "file..bib"+-- > addExtension "file" ".bib" == "file.bib"+-- > addExtension "/" "x" == "/.x"+-- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"+-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"+addExtension :: FilePath -> String -> FilePath+addExtension file "" = file+addExtension file xs@(x:_) = joinDrive a res+ where+ res = if isExtSeparator x then b ++ xs+ else b ++ [extSeparator] ++ xs++ (a,b) = splitDrive file++-- | Does the given filename have an extension?+--+-- > null (takeExtension x) == not (hasExtension x)+hasExtension :: FilePath -> Bool+hasExtension = any isExtSeparator . takeFileName+++-- | Split on all extensions+--+-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")+splitExtensions :: FilePath -> (FilePath, String)+splitExtensions x = (a ++ c, d)+ where+ (a,b) = splitFileName x+ (c,d) = break isExtSeparator b++-- | Drop all extensions+--+-- > not $ hasExtension (dropExtensions x)+dropExtensions :: FilePath -> FilePath+dropExtensions = fst . splitExtensions++-- | Get all extensions+--+-- > takeExtensions "file.tar.gz" == ".tar.gz"+takeExtensions :: FilePath -> String+takeExtensions = snd . splitExtensions++++---------------------------------------------------------------------+-- Drive methods++-- | Is the given character a valid drive letter?+-- only a-z and A-Z are letters, not isAlpha which is more unicodey+isLetter :: Char -> Bool+isLetter x = (x >= 'a' && x <= 'z') || (x >= 'A' && x <= 'Z')+++-- | Split a path into a drive and a path.+-- On Unix, \/ is a Drive.+--+-- > uncurry (++) (splitDrive x) == x+-- > Windows: splitDrive "file" == ("","file")+-- > Windows: splitDrive "c:/file" == ("c:/","file")+-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")+-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")+-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")+-- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")+-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")+-- > Windows: splitDrive "/d" == ("","/d") -- xxx+-- > Posix: splitDrive "/test" == ("/","test") -- xxx+-- > Posix: splitDrive "//test" == ("//","test")+-- > Posix: splitDrive "test/file" == ("","test/file")+-- > Posix: splitDrive "file" == ("","file")+splitDrive :: FilePath -> (FilePath, FilePath)+splitDrive x | isPosix = span (== '/') x++splitDrive x | isJust y = fromJust y+ where y = readDriveLetter x++splitDrive x | isJust y = fromJust y+ where y = readDriveUNC x++splitDrive x | isJust y = fromJust y+ where y = readDriveShare x++splitDrive x = ("",x)++addSlash :: FilePath -> FilePath -> (FilePath, FilePath)+addSlash a xs = (a++c,d)+ where (c,d) = span isPathSeparator xs++-- http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp+-- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"+-- a is "\\?\"+readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)+readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =+ case map toUpper xs of+ ('U':'N':'C':s4:_) | isPathSeparator s4 ->+ let (a,b) = readDriveShareName (drop 4 xs)+ in Just (s1:s2:'?':s3:take 4 xs ++ a, b)+ _ -> case readDriveLetter xs of+ Just (a,b) -> Just (s1:s2:'?':s3:a,b)+ Nothing -> Nothing+readDriveUNC _ = Nothing++{- c:\ -}+readDriveLetter :: String -> Maybe (FilePath, FilePath)+readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)+readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)+readDriveLetter _ = Nothing++{- \\sharename\ -}+readDriveShare :: String -> Maybe (FilePath, FilePath)+readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =+ Just (s1:s2:a,b)+ where (a,b) = readDriveShareName xs+readDriveShare _ = Nothing++{- assume you have already seen \\ -}+{- share\bob -> "share","\","bob" -}+readDriveShareName :: String -> (FilePath, FilePath)+readDriveShareName name = addSlash a b+ where (a,b) = break isPathSeparator name++++-- | Join a drive and the rest of the path.+--+-- > uncurry joinDrive (splitDrive x) == x+-- > Windows: joinDrive "C:" "foo" == "C:foo"+-- > Windows: joinDrive "C:/" "bar" == "C:/bar"+-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share/foo" -- xxx+-- > Windows: joinDrive "/:" "foo" == "/:/foo" -- xxx+joinDrive :: FilePath -> FilePath -> FilePath+joinDrive a b | isPosix = a ++ b+ | null a = b+ | null b = a+ | isPathSeparator (last a) = a ++ b+ | otherwise = case a of+ [a1,':'] | isLetter a1 -> a ++ b+ _ -> a ++ [pathSeparator] ++ b++-- | Get the drive from a filepath.+--+-- > takeDrive x == fst (splitDrive x)+takeDrive :: FilePath -> FilePath+takeDrive = fst . splitDrive++-- | Delete the drive, if it exists.+--+-- > dropDrive x == snd (splitDrive x)+dropDrive :: FilePath -> FilePath+dropDrive = snd . splitDrive++-- | Does a path have a drive.+--+-- > not (hasDrive x) == null (takeDrive x)+hasDrive :: FilePath -> Bool+hasDrive = not . null . takeDrive+++-- | Is an element a drive+isDrive :: FilePath -> Bool+isDrive = null . dropDrive+++---------------------------------------------------------------------+-- Operations on a filepath, as a list of directories++-- | Split a filename into directory and file. 'combine' is the inverse.+--+-- > uncurry (++) (splitFileName x) == x+-- > Valid x => uncurry combine (splitFileName x) == x+-- > splitFileName "file/bob.txt" == ("file/", "bob.txt")+-- > splitFileName "file/" == ("file/", "")+-- > splitFileName "bob" == ("", "bob")+-- > Posix: splitFileName "/" == ("/","")+-- > Windows: splitFileName "c:" == ("c:","")+splitFileName :: FilePath -> (String, String)+splitFileName x = (c ++ reverse b, reverse a)+ where+ (a,b) = break isPathSeparator $ reverse d+ (c,d) = splitDrive x+++-- | Set the filename.+--+-- > Valid x => replaceFileName x (takeFileName x) == x+replaceFileName :: FilePath -> String -> FilePath+replaceFileName x y = dropFileName x </> y++-- | Drop the filename.+--+-- > dropFileName x == fst (splitFileName x)+dropFileName :: FilePath -> FilePath+dropFileName = fst . splitFileName+++-- | Get the file name.+--+-- > takeFileName "test/" == ""+-- > takeFileName x `isSuffixOf` x+-- > takeFileName x == snd (splitFileName x)+-- > Valid x => takeFileName (replaceFileName x "fred") == "fred"+-- > Valid x => takeFileName (x </> "fred") == "fred"+-- > Valid x => isRelative (takeFileName x)+takeFileName :: FilePath -> FilePath+takeFileName = snd . splitFileName++-- | Get the base name, without an extension or path.+--+-- > takeBaseName "file/test.txt" == "test"+-- > takeBaseName "dave.ext" == "dave"+-- > takeBaseName "" == ""+-- > takeBaseName "test" == "test"+-- > takeBaseName (addTrailingPathSeparator x) == ""+-- > takeBaseName "file/file.tar.gz" == "file.tar"+takeBaseName :: FilePath -> String+takeBaseName = dropExtension . takeFileName++-- | Set the base name.+--+-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"+-- > replaceBaseName "fred" "bill" == "bill"+-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"+-- > replaceBaseName x (takeBaseName x) == x+replaceBaseName :: FilePath -> String -> FilePath+replaceBaseName pth nam = combineAlways a (nam <.> ext)+ where+ (a,b) = splitFileName pth+ ext = takeExtension b++-- | Is an item either a directory or the last character a path separator?+--+-- > hasTrailingPathSeparator "test" == False+-- > hasTrailingPathSeparator "test/" == True+hasTrailingPathSeparator :: FilePath -> Bool+hasTrailingPathSeparator "" = False+hasTrailingPathSeparator x = isPathSeparator (last x)+++-- | Add a trailing file path separator if one is not already present.+--+-- > hasTrailingPathSeparator (addTrailingPathSeparator x)+-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x+-- > addTrailingPathSeparator "test/rest" == "test/rest/"+addTrailingPathSeparator :: FilePath -> FilePath+addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]+++-- | Remove any trailing path separators+--+-- > dropTrailingPathSeparator "file/test/" == "file/test"+-- > not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x+-- > dropTrailingPathSeparator "/" == "/"+dropTrailingPathSeparator :: FilePath -> FilePath+dropTrailingPathSeparator x =+ if hasTrailingPathSeparator x && not (isDrive x)+ then let x' = reverse $ dropWhile isPathSeparator $ reverse x+ in if null x' then [pathSeparator] else x'+ else x+++-- | Get the directory name, move up one level.+--+-- > takeDirectory x `isPrefixOf` x+-- > takeDirectory "foo" == ""+-- > takeDirectory "/foo/bar/baz" == "/foo/bar"+-- > takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"+-- > takeDirectory "foo/bar/baz" == "foo/bar"+-- > Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar" -- xxx+-- > Windows: takeDirectory "C:/" == "C:/"+takeDirectory :: FilePath -> FilePath+takeDirectory x = if isDrive file then file+ else if null res && not (null file) then file+ else res+ where+ res = reverse $ dropWhile isPathSeparator $ reverse file+ file = dropFileName x++-- | Set the directory, keeping the filename the same.+--+-- > replaceDirectory x (takeDirectory x) `equalFilePath` x+replaceDirectory :: FilePath -> String -> FilePath+replaceDirectory x dir = combineAlways dir (takeFileName x)+++-- | Combine two paths, if the second path 'isAbsolute', then it returns the second.+--+-- > Valid x => combine (takeDirectory x) (takeFileName x) `equalFilePath` x+-- > combine "/" "test" == "/test"+-- > combine "home" "bob" == "home/bob"+combine :: FilePath -> FilePath -> FilePath+combine a b | hasDrive b || (not (null b) && isPathSeparator (head b)) = b+ | otherwise = combineAlways a b++-- | Combine two paths, assuming rhs is NOT absolute.+combineAlways :: FilePath -> FilePath -> FilePath+combineAlways a b | null a = b+ | null b = a+ | isPathSeparator (last a) = a ++ b+ | isDrive a = joinDrive a b+ | otherwise = a ++ [pathSeparator] ++ b+++-- | A nice alias for 'combine'.+(</>) :: FilePath -> FilePath -> FilePath+(</>) = combine+++-- | Split a path by the directory separator.+--+-- > concat (splitPath x) == x+-- > splitPath "test//item/" == ["test//","item/"]+-- > splitPath "test/item/file" == ["test/","item/","file"]+-- > splitPath "" == []+-- > Windows: splitPath "c:/test/path" == ["c:/","test/","path"]+-- > Posix: splitPath "/file/test" == ["/","file/","test"]+splitPath :: FilePath -> [FilePath]+splitPath x = [drive | drive /= ""] ++ f path+ where+ (drive,path) = splitDrive x++ f "" = []+ f y = (a++c) : f d+ where+ (a,b) = break isPathSeparator y+ (c,d) = break (not . isPathSeparator) b++-- | Just as 'splitPath', but don't add the trailing slashes to each element.+--+-- > splitDirectories "test/file" == ["test","file"]+-- > splitDirectories "/test/file" == ["/","test","file"]+-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x+-- > splitDirectories "" == []+splitDirectories :: FilePath -> [FilePath]+splitDirectories path =+ if hasDrive path then head pathComponents : f (tail pathComponents)+ else f pathComponents+ where+ pathComponents = splitPath path++ f xs = map g xs+ g x = if null res then x else res+ where res = takeWhile (not . isPathSeparator) x+++-- | Join path elements back together.+--+-- > Valid x => joinPath (splitPath x) == x+-- > joinPath [] == ""+-- > Posix: joinPath ["test","file","path"] == "test/file/path"++-- Note that this definition on c:\\c:\\, join then split will give c:\\.+joinPath :: [FilePath] -> FilePath+joinPath x = foldr combine "" x+++++++---------------------------------------------------------------------+-- File name manipulators++-- | Equality of two 'FilePath's.+-- If you call @System.Directory.canonicalizePath@+-- first this has a much better chance of working.+-- Note that this doesn't follow symlinks or DOSNAM~1s.+--+-- > x == y ==> equalFilePath x y+-- > normalise x == normalise y ==> equalFilePath x y+-- > Posix: equalFilePath "foo" "foo/"+-- > Posix: not (equalFilePath "foo" "/foo")+-- > Posix: not (equalFilePath "foo" "FOO")+-- > Windows: equalFilePath "foo" "FOO"+equalFilePath :: FilePath -> FilePath -> Bool+equalFilePath a b = f a == f b+ where+ f x | isWindows = dropTrailSlash $ map toLower $ normalise x+ | otherwise = dropTrailSlash $ normalise x++ dropTrailSlash x | length x >= 2 && isPathSeparator (last x) = init x+ | otherwise = x+++-- | Contract a filename, based on a relative path.+--+-- There is no corresponding @makeAbsolute@ function, instead use+-- @System.Directory.canonicalizePath@ which has the same effect.+--+-- > Valid y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x+-- > makeRelative x x == "."+-- > null y || equalFilePath (makeRelative x (x </> y)) y || null (takeFileName x)+-- > Windows: makeRelative "C:/Home" "c:/home/bob" == "bob"+-- > Windows: makeRelative "C:/Home" "D:/Home/Bob" == "D:/Home/Bob"+-- > Windows: makeRelative "C:/Home" "C:Home/Bob" == "C:Home/Bob"+-- > Windows: makeRelative "/Home" "/home/bob" == "bob"+-- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob"+-- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"+-- > Posix: makeRelative "/fred" "bob" == "bob"+-- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred"+-- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/"+-- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"+makeRelative :: FilePath -> FilePath -> FilePath+makeRelative root path+ | equalFilePath root path = "."+ | takeAbs root /= takeAbs path = path+ | otherwise = f (dropAbs root) (dropAbs path)+ where+ f "" y = dropWhile isPathSeparator y+ f x y = let (x1,x2) = g x+ (y1,y2) = g y+ in if equalFilePath x1 y1 then f x2 y2 else path++ g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)+ where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x++ -- on windows, need to drop '/' which is kind of absolute, but not a drive+ dropAbs (x:xs) | isPathSeparator x = xs+ dropAbs x = dropDrive x++ takeAbs (x:_) | isPathSeparator x = [pathSeparator]+ takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x++-- | Normalise a file+--+-- * \/\/ outside of the drive can be made blank+--+-- * \/ -> 'pathSeparator'+--+-- * .\/ -> \"\"+--+-- > Posix: normalise "/file/\\test////" == "/file/\\test/"+-- > Posix: normalise "/file/./test" == "/file/test"+-- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"+-- > Posix: normalise "../bob/fred/" == "../bob/fred/"+-- > Posix: normalise "./bob/fred/" == "bob/fred/"+-- > Windows: normalise "c:\\file/bob\\" == "C:/file/bob/"+-- > Windows: normalise "c:/" == "C:/"+-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" -- xxx+-- > Windows: normalise "." == "."+-- > Posix: normalise "./" == "./"+normalise :: FilePath -> FilePath+normalise path = joinDrive (normaliseDrive drv) (f pth)+ ++ [pathSeparator | not (null pth) && isPathSeparator (last pth)]+ where+ (drv,pth) = splitDrive path++ f = joinPath . dropDots [] . splitDirectories . propSep++ propSep (a:b:xs)+ | isPathSeparator a && isPathSeparator b = propSep (a:xs)+ propSep (a:xs)+ | isPathSeparator a = pathSeparator : propSep xs+ propSep (x:xs) = x : propSep xs+ propSep [] = []++ dropDots acc (".":xs) | not $ null xs = dropDots acc xs+ dropDots acc (x:xs) = dropDots (x:acc) xs+ dropDots acc [] = reverse acc++normaliseDrive :: FilePath -> FilePath+normaliseDrive drive | isPosix = drive+normaliseDrive drive = if isJust $ readDriveLetter x2+ then map toUpper x2+ else drive+ where+ x2 = map repSlash drive++ repSlash x = if isPathSeparator x then pathSeparator else x++{- xxx+-- information for validity functions on Windows+-- see http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp+badCharacters :: [Char]+badCharacters = ":*?><|\""+badElements :: [FilePath]+badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", "CLOCK$"]++-- | Is a FilePath valid, i.e. could you create a file like it?+--+-- > isValid "" == False+-- > Posix: isValid "/random_ path:*" == True+-- > Posix: isValid x == not (null x)+-- > Windows: isValid "c:\\test" == True+-- > Windows: isValid "c:\\test:of_test" == False+-- > Windows: isValid "test*" == False+-- > Windows: isValid "c:\\test\\nul" == False+-- > Windows: isValid "c:\\test\\prn.txt" == False+-- > Windows: isValid "c:\\nul\\file" == False+-- > Windows: isValid "\\\\" == False+isValid :: FilePath -> Bool+isValid "" = False+isValid _ | isPosix = True+isValid path =+ not (any (`elem` badCharacters) x2) &&+ not (any f $ splitDirectories x2) &&+ not (length path >= 2 && all isPathSeparator path)+ where+ x2 = dropDrive path+ f x = map toUpper (dropExtensions x) `elem` badElements+++-- | Take a FilePath and make it valid; does not change already valid FilePaths.+--+-- > isValid (makeValid x)+-- > isValid x ==> makeValid x == x+-- > makeValid "" == "_"+-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"+-- > Windows: makeValid "test*" == "test_"+-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"+-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"+-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"+-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"+makeValid :: FilePath -> FilePath+makeValid "" = "_"+makeValid path | isPosix = path+makeValid x | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"+makeValid path = joinDrive drv $ validElements $ validChars pth+ where+ (drv,pth) = splitDrive path++ validChars x = map f x+ f x | x `elem` badCharacters = '_'+ | otherwise = x++ validElements x = joinPath $ map g $ splitPath x+ g x = h (reverse b) ++ reverse a+ where (a,b) = span isPathSeparator $ reverse x+ h x = if map toUpper a `elem` badElements then a ++ "_" <.> b else x+ where (a,b) = splitExtensions x+-}++-- | Is a path relative, or is it fixed to the root?+--+-- > Windows: isRelative "path\\test" == True+-- > Windows: isRelative "c:\\test" == False+-- > Windows: isRelative "c:test" == True+-- > Windows: isRelative "c:" == True+-- > Windows: isRelative "\\\\foo" == False+-- > Windows: isRelative "/foo" == True+-- > Posix: isRelative "test/path" == True+-- > Posix: isRelative "/test" == False+isRelative :: FilePath -> Bool+isRelative = isRelativeDrive . takeDrive+++-- > isRelativeDrive "" == True+-- > Windows: isRelativeDrive "c:\\" == False+-- > Windows: isRelativeDrive "c:/" == False+-- > Windows: isRelativeDrive "c:" == True+-- > Windows: isRelativeDrive "\\\\foo" == False+-- > Posix: isRelativeDrive "/" == False+isRelativeDrive :: String -> Bool+isRelativeDrive x = null x ||+ maybe False (not . isPathSeparator . last . fst) (readDriveLetter x)+++-- | @not . 'isRelative'@+--+-- > isAbsolute x == not (isRelative x)+isAbsolute :: FilePath -> Bool+isAbsolute = not . isRelative++{-+Copyright Neil Mitchell 2005-2007.+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 the name of Neil Mitchell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER OR 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.+-}
+ System/EasyFile/Missing.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE CPP #-}++module System.EasyFile.Missing where++----------------------------------------------------------------++import Control.Applicative+import Data.Time+import Data.Time.Clock.POSIX+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+import System.Win32.File+import System.Win32.Time+#else+import System.Posix.Files+import System.Posix.Types+#endif++----------------------------------------------------------------++{-|+ This function tells whether or not a file\/directory is symbolic+ link.+-}+isSymlink :: FilePath -> IO Bool+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+isSymlink _ = return False+#else+isSymlink file = isSymbolicLink <$> getSymbolicLinkStatus file+#endif++{-|+ This function returns the link counter of a file\/directory.+-}+getLinkCount :: FilePath -> IO (Maybe Int)+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+getLinkCount _ = return Nothing+#else+getLinkCount file = Just . fromIntegral . linkCount <$> getFileStatus file+#endif++{-|+ This function returns whether or not a directory has sub-directories.+-}+hasSubDirectories :: FilePath -> IO (Maybe Bool)+#ifdef darwin_HOST_OS+hasSubDirectories _ = return Nothing+#else+hasSubDirectories file = do+ Just n <- getLinkCount file+ return $ Just (n > 2)+#endif++----------------------------------------------------------------++{-|+The 'getCreationTime' operation returns the+UTC time at which the file or directory was created.+The time is only available on Windows.+-}+getCreationTime :: FilePath -> IO (Maybe UTCTime)+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+getCreationTime file = Just . creationTime <$> fileTime file+#else+getCreationTime _ = return Nothing+#endif++{-|+The 'getCreationTime' operation returns the+UTC time at which the file or directory was changed.+The time is only available on Unix and Mac.+Note that Unix's rename() does not change ctime but+MacOS's rename() does.+-}+getChangeTime :: FilePath -> IO (Maybe UTCTime)+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+getChangeTime _ = return Nothing+#else+getChangeTime file = Just . epochTimeToUTCTime . statusChangeTime <$> getFileStatus file+#endif++{-|+The 'getModificationTime' operation returns the+UTC 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 UTCTime+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+getModificationTime file = writeTime <$> fileTime file+#else+getModificationTime file = epochTimeToUTCTime . modificationTime <$> getFileStatus file+#endif++{-+ http://msdn.microsoft.com/en-us/library/ms724290%28VS.85%29.aspx+ The NTFS file system delays updates to the last access time for+ a file by up to 1 hour after the last access.+-}+{-|+The 'getModificationTime' operation returns the+UTC time at which the file or directory was last accessed.+-}+getAccessTime :: FilePath -> IO UTCTime+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+getAccessTime file = accessTime <$> fileTime file+#else+getAccessTime file = epochTimeToUTCTime . accessTime <$> getFileStatus file+#endif++----------------------------------------------------------------++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+creationTime :: (UTCTime,UTCTime,UTCTime) -> UTCTime+creationTime (ctime,_,_) = ctime++accessTime :: (UTCTime,UTCTime,UTCTime) -> UTCTime+accessTime (_,atime,_) = atime++writeTime :: (UTCTime,UTCTime,UTCTime) -> UTCTime+writeTime (_,_,wtime) = wtime++fileTime :: FilePath -> IO (UTCTime,UTCTime,UTCTime)+fileTime file = do+ fh <- createFile file gENERIC_READ fILE_SHARE_READ Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing+ (ctime,atime,mtime) <- getFileTime fh+ closeHandle fh+ return (filetimeToUTCTime ctime+ ,filetimeToUTCTime atime+ ,filetimeToUTCTime mtime)++{-+ http://support.microsoft.com/kb/167296/en-us+ 100 nano seconds since 1 Jan 1601+ MS: _FILETIME = {DWORD,DWORD} = {Word32,Word32}+ Haskell: FILETIME == DDWORD == Word64+-}+filetimeToUTCTime :: FILETIME -> UTCTime+filetimeToUTCTime (FILETIME x) = posixSecondsToUTCTime . realToFrac $ tm+ where+ tm :: Integer+ tm = (fromIntegral x - 116444736000000000) `div` 10000000+#else+epochTimeToUTCTime :: EpochTime -> UTCTime+epochTimeToUTCTime = posixSecondsToUTCTime . realToFrac+#endif
+ easy-file.cabal view
@@ -0,0 +1,29 @@+Name: easy-file+Version: 0.1.0+Author: Kazu Yamamoto <kazu@iij.ad.jp>+Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>+License: BSD3+License-File: LICENSE+Synopsis: Cross-platform File handling+Description: Cross-platform File handling for Unix/Mac/Windows+Homepage: http://github.com/kazu-yamamoto/easy-file+Category: System+Cabal-Version: >= 1.6+Build-Type: Simple+library+ if impl(ghc >= 6.12)+ GHC-Options: -Wall -fno-warn-unused-do-bind+ else+ GHC-Options: -Wall+ Exposed-Modules: System.EasyFile+ Other-Modules: System.EasyFile.FilePath+ System.EasyFile.Directory+ System.EasyFile.Missing+ Build-Depends: base >= 4 && < 5+ if os(windows)+ Build-Depends: Win32, time, directory, filepath+ else+ Build-Depends: unix, time, directory, filepath+Source-Repository head+ Type: git+ Location: git://github.com/kazu-yamamoto/easy-file.git