easy-file 0.2.5 → 0.2.6
raw patch · 9 files changed
+604/−503 lines, 9 filesdep ~basesetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- ChangeLog.md +36/−0
- README.md +26/−0
- Setup.hs +1/−0
- System/EasyFile.hs +83/−78
- System/EasyFile/Directory.hs +145/−159
- System/EasyFile/FilePath.hs +196/−187
- System/EasyFile/Missing.hs +41/−51
- easy-file.cabal +13/−22
- test/Test.hs +63/−6
+ ChangeLog.md view
@@ -0,0 +1,36 @@+## v0.2.6++- Supporting GHC 9.2 or later only.+- Fixing `setFileSize` leaking a file handle on Windows.+- `hasSubDirectories` returns `Nothing` on Windows instead of+ throwing an exception.+- Documenting that timestamps are truncated to seconds and that+ `canonicalizePath` may return a path with `\` on Windows.++## v0.2.5++- setFileSizer can be built but raises an error for GHC < 8.10.6.+ [#10](https://github.com/kazu-yamamoto/easy-file/pull/10)++## v0.2.4++- Providing `setFileSize`.++## v0.2.3++- Catching up the current environment (2018 -> 2023)+ [#7](https://github.com/kazu-yamamoto/easy-file/pull/7)++## v0.2.2++- win32 file open for getting metadata+ [#5](https://github.com/kazu-yamamoto/easy-file/pull/5)++## v0.2.1++- Fixing the document+ [#3](https://github.com/kazu-yamamoto/easy-file/pull/3)++## v0.2.0++- Providing `getFileSize`.
+ README.md view
@@ -0,0 +1,26 @@+++# Easy file handling for Haskell++This is a Haskell package of cross-platform file handling for Unix/Mac/Windows.++The current Haskell modules have following shortcomings:++- getModificationTime exists in System.Directory. But getAccessTime,+ getStatusChangeTime, 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 package aims to resolve these problems.
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
System/EasyFile.hs view
@@ -1,88 +1,93 @@-{-|-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:+-- |+-- 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', truncated to seconds.+--+-- * 'isSymlink', 'getLinkCount', and 'hasSubDirectories'.+--+-- * \'\/\' as the single 'pathSeparator'. For instance,+-- 'getCurrentDirectory' returns a path whose separator is \'\/\'+-- even on Windows. Note that 'canonicalizePath', re-exported from+-- "System.Directory" as is, may return a path with \'\\\' on Windows.+--+-- * 'getHomeDirectory2' which refers the @HOME@ environment variable.+--+-- * Necessary functions in "System.Directory" and "System.FilePath".+module System.EasyFile (+ -- * Actions on directories+ createDirectory,+ createDirectoryIfMissing,+ removeDirectory,+ removeDirectoryRecursive,+ renameDirectory,+ getDirectoryContents,+ getCurrentDirectory,+ setCurrentDirectory, -* 'getModificationTime', 'getAccessTime', 'getChangeTime', and- 'getCreationTime'. They return 'UTCTime'.+ -- * Pre-defined directories+ getHomeDirectory,+ getHomeDirectory2, -- missing+ getAppUserDataDirectory,+ getUserDocumentsDirectory,+ getTemporaryDirectory, -* 'isSymlink', 'getLinkCount', and 'hasSubDirectories'.+ -- * Actions on files+ removeFile,+ renameFile,+ copyFile,+ canonicalizePath,+ -- , makeRelativeToCurrentDirectory -- xxx+ -- , findExecutable -- xxx -* \'\/\' as the single 'pathSeparator'. For instance,- 'getCurrentDirectory' returns a path whose separator is \'\/\'- even on Windows.+ -- * Existence tests+ doesFileExist,+ doesDirectoryExist, -* 'getHomeDirectory2' which refers the @HOME@ environment variable.+ -- * Permissions+ Permissions (..),+ getPermissions,+ setPermissions,+ copyPermissions, -* Necessary functions in "System.Directory" and "System.FilePath".+ -- * Timestamps+ getCreationTime,+ getChangeTime,+ getModificationTime,+ getAccessTime, --}+ -- * Size+ getFileSize,+ setFileSize, -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- -- * Size- , getFileSize- , setFileSize- -- * File\/directory information- , isSymlink- , getLinkCount- , hasSubDirectories- , module System.EasyFile.FilePath- ) where+ -- * File\/directory information+ isSymlink,+ getLinkCount,+ hasSubDirectories,+ module System.EasyFile.FilePath,+) where ----------------------------------------------------------------
System/EasyFile/Directory.hs view
@@ -1,185 +1,172 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-} module System.EasyFile.Directory (- module System.EasyFile.Directory- , module System.Directory- ) where+ 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- )+ Permissions (..),+ canonicalizePath,+ copyFile,+ createDirectory,+ createDirectoryIfMissing,+ doesDirectoryExist,+ doesFileExist,+ getDirectoryContents,+ getPermissions,+ removeDirectory,+ removeDirectoryRecursive,+ removeFile,+ renameDirectory,+ renameFile,+ setCurrentDirectory,+ setPermissions,+ ) import qualified System.Directory as D (- getCurrentDirectory- , getHomeDirectory- , getAppUserDataDirectory- , getUserDocumentsDirectory- , getTemporaryDirectory- , copyPermissions- )+ copyPermissions,+ getAppUserDataDirectory,+ getCurrentDirectory,+ getHomeDirectory,+ getTemporaryDirectory,+ getUserDocumentsDirectory,+ ) -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif-import qualified Control.Exception as E import System.Environment+import qualified System.IO.Error as E ---------------------------------------------------------------- -{- |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.---}+-- | 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.--}+-- | 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.--}-+-- | Returns the current user's home directory from+-- the @HOME@ environment variable. getHomeDirectory2 :: IO (Maybe FilePath)-getHomeDirectory2 = (Just . fixPath <$> getEnv "HOME") `E.catch`- \(_ :: E.IOException) -> 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.--}+getHomeDirectory2 =+ (Just . fixPath <$> getEnv "HOME")+ `E.catchIOError` \_ -> 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.--}+-- | 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.--}-+-- | 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 @@ -198,8 +185,7 @@ ---------------------------------------------------------------- -- Just adding documentation. -{-|- This function copy the permission of the first file to the second.--}+-- |+-- This function copy the permission of the first file to the second. copyPermissions :: FilePath -> FilePath -> IO () copyPermissions = D.copyPermissions
System/EasyFile/FilePath.hs view
@@ -10,33 +10,53 @@ module System.EasyFile.FilePath ( -- * Separator predicates FilePath,- pathSeparator, pathSeparators, isPathSeparator,-{- xxx- searchPathSeparator, isSearchPathSeparator,--}- extSeparator, isExtSeparator,--{- xxx- -- * Path methods (environment $PATH)- splitSearchPath, getSearchPath,--}+ 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,+ takeExtension,+ replaceExtension,+ dropExtension,+ addExtension,+ hasExtension,+ (<.>),+ splitExtensions,+ dropExtensions,+ takeExtensions, -- * Drive methods- splitDrive, joinDrive,- takeDrive, hasDrive, dropDrive, isDrive,+ 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,+ takeFileName,+ replaceFileName,+ dropFileName,+ takeBaseName,+ replaceBaseName,+ takeDirectory,+ replaceDirectory,+ combine,+ (</>),+ splitPath,+ joinPath,+ splitDirectories, -- * Low level FilePath operators hasTrailingPathSeparator,@@ -44,32 +64,28 @@ dropTrailingPathSeparator, -- * File name manipulators- normalise, equalFilePath,+ normalise,+ equalFilePath, makeRelative,- isRelative, isAbsolute,-{- xxx- isValid, makeValid--}+ isRelative,+ isAbsolute, #ifdef TESTING- , isRelativeDrive+ isRelativeDrive, #endif-- )- where+ {- xxx+ isValid, makeValid+ -}+)+where -import Data.Char(toLower, toUpper)-import Data.Maybe(isJust, fromJust)+import Data.Char (toLower, toUpper)+import Data.Maybe (fromJust, isJust) -- import System.Environment(getEnv) -- xxx --infixr 7 <.>-infixr 5 </>----+infixr 7 <.>+infixr 5 </> --------------------------------------------------------------------- -- Platform Abstraction Methods (private)@@ -111,7 +127,6 @@ isPathSeparator :: Char -> Bool isPathSeparator = (`elem` pathSeparators) - {- xxx -- | The character that is used to separate the entries in the $PATH environment variable. --@@ -139,9 +154,6 @@ isExtSeparator :: Char -> Bool isExtSeparator = (== extSeparator) --- {- xxx --------------------------------------------------------------------- -- Path methods (environment $PATH)@@ -165,7 +177,6 @@ g "" = ["." | isPosix] g x = [x] - -- | Get a list of filepaths in the $PATH. getSearchPath :: IO [FilePath] getSearchPath = fmap splitSearchPath (getEnv "PATH")@@ -187,11 +198,11 @@ -- > 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+ "" -> (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. --@@ -232,12 +243,14 @@ -- > 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+addExtension file xs@(x : _) = joinDrive a res+ where+ res =+ if isExtSeparator x+ then b ++ xs+ else b ++ [extSeparator] ++ xs - (a,b) = splitDrive file+ (a, b) = splitDrive file -- | Does the given filename have an extension? --@@ -245,15 +258,14 @@ 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+ where+ (a, b) = splitFileName x+ (c, d) = break isExtSeparator b -- | Drop all extensions --@@ -267,8 +279,6 @@ takeExtensions :: FilePath -> String takeExtensions = snd . splitExtensions -- --------------------------------------------------------------------- -- Drive methods @@ -277,7 +287,6 @@ 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. --@@ -296,56 +305,58 @@ -- > Posix: splitDrive "file" == ("","file") splitDrive :: FilePath -> (FilePath, FilePath) splitDrive x | isPosix = span (== '/') x- splitDrive x | isJust y = fromJust y- where y = readDriveLetter x-+ where+ y = readDriveLetter x splitDrive x | isJust y = fromJust y- where y = readDriveUNC x-+ where+ y = readDriveUNC x splitDrive x | isJust y = fromJust y- where y = readDriveShare x--splitDrive x = ("",x)+ where+ y = readDriveShare x+splitDrive x = ("", x) addSlash :: FilePath -> FilePath -> (FilePath, FilePath)-addSlash a xs = (a++c,d)- where (c,d) = span isPathSeparator xs+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] =+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)+ ('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+ 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 (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 (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--+ where+ (a, b) = break isPathSeparator name -- | Join a drive and the rest of the path. --@@ -355,13 +366,14 @@ -- > 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+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. --@@ -381,12 +393,10 @@ 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 @@ -401,10 +411,9 @@ -- > 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-+ where+ (a, b) = break isPathSeparator $ reverse d+ (c, d) = splitDrive x -- | Set the filename. --@@ -418,7 +427,6 @@ dropFileName :: FilePath -> FilePath dropFileName = fst . splitFileName - -- | Get the file name. -- -- > takeFileName "test/" == ""@@ -449,9 +457,9 @@ -- > replaceBaseName x (takeBaseName x) == x replaceBaseName :: FilePath -> String -> FilePath replaceBaseName pth nam = combineAlways a (nam <.> ext)- where- (a,b) = splitFileName pth- ext = takeExtension b+ where+ (a, b) = splitFileName pth+ ext = takeExtension b -- | Is an item either a directory or the last character a path separator? --@@ -461,7 +469,6 @@ hasTrailingPathSeparator "" = False hasTrailingPathSeparator x = isPathSeparator (last x) - -- | Add a trailing file path separator if one is not already present. -- -- > hasTrailingPathSeparator (addTrailingPathSeparator x)@@ -470,7 +477,6 @@ addTrailingPathSeparator :: FilePath -> FilePath addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator] - -- | Remove any trailing path separators -- -- > dropTrailingPathSeparator "file/test/" == "file/test"@@ -479,10 +485,10 @@ 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-+ 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. --@@ -494,12 +500,16 @@ -- > 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+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. --@@ -507,30 +517,29 @@ 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 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-+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@@ -541,14 +550,14 @@ -- > Posix: splitPath "/file/test" == ["/","file/","test"] splitPath :: FilePath -> [FilePath] splitPath x = [drive | drive /= ""] ++ f path- where- (drive,path) = splitDrive x+ where+ (drive, path) = splitDrive x - f "" = []- f y = (a++c) : f d- where- (a,b) = break isPathSeparator y- (c,d) = break (not . isPathSeparator) b+ 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. --@@ -558,15 +567,16 @@ -- > splitDirectories "" == [] splitDirectories :: FilePath -> [FilePath] splitDirectories path =- if hasDrive path then head pathComponents : f (tail pathComponents)+ 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+ 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. --@@ -578,11 +588,6 @@ joinPath :: [FilePath] -> FilePath joinPath x = foldr combine "" x ----- --------------------------------------------------------------------- -- File name manipulators @@ -599,13 +604,14 @@ -- > 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+ 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. --@@ -627,24 +633,27 @@ -- > 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+ | 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+ 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+ -- 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+ takeAbs (x : _) | isPathSeparator x = [pathSeparator]+ takeAbs x =+ map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x -- | Normalise a file --@@ -665,33 +674,35 @@ -- > 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+normalise path =+ joinDrive (normaliseDrive drv) (f pth)+ ++ [pathSeparator | not (null pth) && isPathSeparator (last pth)]+ where+ (drv, pth) = splitDrive path - f = joinPath . dropDots [] . splitDirectories . propSep+ 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 [] = []+ 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+ 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+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+ repSlash x = if isPathSeparator x then pathSeparator else x {- xxx -- information for validity functions on Windows@@ -724,7 +735,6 @@ 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)@@ -768,7 +778,6 @@ isRelative :: FilePath -> Bool isRelative = isRelativeDrive . takeDrive - -- > isRelativeDrive "" == True -- > Windows: isRelativeDrive "c:\\" == False -- > Windows: isRelativeDrive "c:/" == False@@ -776,9 +785,9 @@ -- > Windows: isRelativeDrive "\\\\foo" == False -- > Posix: isRelativeDrive "/" == False isRelativeDrive :: String -> Bool-isRelativeDrive x = null x ||- maybe False (not . isPathSeparator . last . fst) (readDriveLetter x)-+isRelativeDrive x =+ null x+ || maybe False (not . isPathSeparator . last . fst) (readDriveLetter x) -- | @not . 'isRelative'@ --
System/EasyFile/Missing.hs view
@@ -4,9 +4,6 @@ ---------------------------------------------------------------- -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif import Data.Time import Data.Time.Clock.POSIX import Data.Word (Word64)@@ -22,10 +19,9 @@ ---------------------------------------------------------------- -{-|- This function tells whether or not a file\/directory is symbolic- link.--}+-- |+-- 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@@ -33,9 +29,8 @@ isSymlink file = isSymbolicLink <$> getSymbolicLinkStatus file #endif -{-|- This function returns the link counter of a file\/directory.--}+-- |+-- 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@@ -43,25 +38,23 @@ getLinkCount file = Just . fromIntegral . linkCount <$> getFileStatus file #endif -{-|- This function returns whether or not a directory has sub-directories.--}+-- |+-- This function returns whether or not a directory has sub-directories.+-- It returns 'Nothing' on Mac and Windows. Since it relies on the link+-- counter, the result is wrong on file systems such as btrfs. hasSubDirectories :: FilePath -> IO (Maybe Bool) #ifdef darwin_HOST_OS hasSubDirectories _ = return Nothing #else-hasSubDirectories file = do- Just n <- getLinkCount file- return $ Just (n > 2)+hasSubDirectories file = fmap (> 2) <$> getLinkCount file #endif ---------------------------------------------------------------- -{-|-The 'getCreationTime' operation returns the-UTC time at which the file or directory was created.-The time is only available on Windows.--}+-- |+-- 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@@ -69,13 +62,12 @@ getCreationTime _ = return Nothing #endif -{-|-The 'getChangeTime' 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.--}+-- |+-- The 'getChangeTime' 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@@ -83,18 +75,17 @@ 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.---}+-- |+-- The 'getModificationTime' operation returns the+-- UTC time at which the file or directory was last modified.+-- Unlike the one in "System.Directory", the time is truncated to seconds.+--+-- 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@@ -107,10 +98,11 @@ 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.--}++-- |+-- The 'getAccessTime' operation returns the+-- UTC time at which the file or directory was last accessed.+-- The time is truncated to seconds. getAccessTime :: FilePath -> IO UTCTime #if defined(mingw32_HOST_OS) || defined(__MINGW32__) getAccessTime file = accessTime <$> fileTime file@@ -179,14 +171,12 @@ -- Since: 0.2.4. setFileSize :: FilePath -> Word64 -> IO () #if (defined(mingw32_HOST_OS) || defined(__MINGW32__))-# if MIN_VERSION_Win32(2, 6, 2)-setFileSize file siz = do- hdl <- createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing- _ <- setFilePointerEx hdl (fromIntegral siz) fILE_CURRENT+setFileSize file siz = bracket setup closeHandle $ \hdl -> do+ _ <- setFilePointerEx hdl (fromIntegral siz) fILE_BEGIN setEndOfFile hdl-# else-setFileSize _ _ = error "GHC 8.10.5 or earlier does not provide setFilePointerEx"-# endif+ where+ setup = createFile file gENERIC_WRITE fILE_SHARE_NONE Nothing+ oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing #else setFileSize file siz = P.setFileSize file $ fromIntegral siz #endif
easy-file.cabal view
@@ -1,32 +1,25 @@-Cabal-Version: >= 1.10+Cabal-Version: 2.4 Name: easy-file-Version: 0.2.5+Version: 0.2.6 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>-License: BSD3+License: BSD-3-Clause 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 Build-Type: Simple+Extra-Doc-Files: ChangeLog.md README.md Tested-With:- GHC == 9.6.0- GHC == 9.4.4- GHC == 9.2.7- GHC == 9.0.2- GHC == 8.10.7- GHC == 8.8.4- GHC == 8.6.5- GHC == 8.4.4- GHC == 8.2.2- GHC == 8.0.2- GHC == 7.10.3- GHC == 7.8.4- GHC == 7.6.3- GHC == 7.4.2- GHC == 7.0.4+ GHC == 9.14.1+ GHC == 9.12.4+ GHC == 9.10.3+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8 Library Exposed-Modules: System.EasyFile@@ -34,7 +27,7 @@ System.EasyFile.Directory System.EasyFile.Missing Build-Depends:- base >= 4 && < 5+ base >= 4.16 && < 5 , directory , filepath , time@@ -45,9 +38,7 @@ Build-Depends: unix Default-Language: Haskell2010- GHC-Options: -Wall- if impl(ghc >= 8)- GHC-Options: -Wcompat+ GHC-Options: -Wall -Wcompat Test-Suite test
test/Test.hs view
@@ -2,15 +2,27 @@ module Main where +import Control.Exception (bracket) import System.EasyFile+import System.IO import Test.Tasty import Test.Tasty.HUnit main :: IO ()-main = defaultMain $- testCase "easy-file tests" $ do+main =+ defaultMain $+ testGroup+ "easy-file"+ [ testCase "path" testPath+ , testCase "setFileSize" testSetFileSize+ , testCase "hasSubDirectories" testHasSubDirectories+ , testCase "metadata of a file open for writing" testOpenForWriting+ ] - assertEqual "Test that '/' is path separator"+testPath :: Assertion+testPath = do+ assertEqual+ "Test that '/' is path separator" ("foo" </> "bar") "foo/bar" @@ -22,10 +34,55 @@ isRelative "c:/foo" @?= not isWindows +-- The file must not be left open: getting its size and removing it work.+testSetFileSize :: Assertion+testSetFileSize = withTempDir "setFileSize" $ \dir -> do+ let file = dir </> "file"+ writeFile file "0123456789"+ setFileSize file 4+ getFileSize file >>= (@?= 4)+ setFileSize file 16+ getFileSize file >>= (@?= 16)+ removeFile file++testHasSubDirectories :: Assertion+testHasSubDirectories = withTempDir "hasSubDirectories" $ \dir -> do+ createDirectory $ dir </> "sub"+ r <- hasSubDirectories dir+ if isWindows || isMac+ then r @?= Nothing+ else r @?= Just True++testOpenForWriting :: Assertion+testOpenForWriting = withTempDir "openForWriting" $ \dir -> do+ let file = dir </> "file"+ withFile file WriteMode $ \h -> do+ hPutStr h "0123456789" >> hFlush h+ _ <- getModificationTime file+ _ <- getAccessTime file+ getFileSize file >>= (@?= 10)++withTempDir :: String -> (FilePath -> IO a) -> IO a+withTempDir name = bracket setup removeDirectoryRecursive+ where+ setup = do+ tmp <- getTemporaryDirectory+ let dir = tmp </> ("easy-file-test-" ++ name)+ exist <- doesDirectoryExist dir+ if exist then removeDirectoryRecursive dir else return ()+ createDirectory dir+ return dir+ isWindows :: Bool-isWindows = #if defined(mingw32_HOST_OS) || defined(__MINGW32__)- True+isWindows = True #else- False+isWindows = False+#endif++isMac :: Bool+#ifdef darwin_HOST_OS+isMac = True+#else+isMac = False #endif