diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +# Path IO 0.1.0 + +* Initial release. diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2016 Mark Karpov + +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 Mark Karpov nor the names of 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 “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 HOLDERS 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. diff --git a/Path/IO.hs b/Path/IO.hs new file mode 100644 --- /dev/null +++ b/Path/IO.hs @@ -0,0 +1,921 @@ +-- | +-- Module : Path.IO +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- This module provides interface to "System.Directory" for users of "Path" +-- module. It also implements commonly used primitives like recursive +-- scanning and copying of directories. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} + +module Path.IO + ( -- * Actions on directories + createDir + , createDirIfMissing + , removeDir + , removeDirRecur + , renameDir + , listDir + , listDirRecur + , copyDirRecur + -- ** Current working directory + , getCurrentDir + , setCurrentDir + , withCurrentDir + -- * Pre-defined directories + , getHomeDir + , getAppUserDataDir + , getUserDocsDir + , getTempDir + -- * Path transformation + , AbsPath + , AnyPath (..) + -- * Actions on files + , removeFile + , renameFile + , copyFile + , findExecutable + , findFile + , findFiles + , findFilesWith + -- * Existence tests + , doesFileExist + , doesDirExist + , isLocationOccupied + -- * Permissions + , D.Permissions + , D.emptyPermissions + , D.readable + , D.writable + , D.executable + , D.searchable + , D.setOwnerReadable + , D.setOwnerWritable + , D.setOwnerExecutable + , D.setOwnerSearchable + , getPermissions + , setPermissions + , copyPermissions + -- * Timestamps +#if MIN_VERSION_directory(1,2,3) + , getAccessTime + , setAccessTime + , setModificationTime +#endif + , getModificationTime ) +where + +import Control.Monad +import Control.Monad.Catch +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Either (lefts, rights) +import Data.Foldable (foldl') +import Data.List ((\\)) +import Data.Maybe (listToMaybe) +import Data.Time (UTCTime) +import Path +import qualified System.Directory as D +import qualified System.FilePath as F + +#if !MIN_VERSION_base(4,8,0) +import Data.Monoid (mappend) +#endif + +---------------------------------------------------------------------------- +-- Actions on directories + +-- | @'createDir' 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]@ + +createDir :: MonadIO m => Path b Dir -> m () +createDir = liftD D.createDirectory + +-- | @'createDirIfMissing' 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. + +createDirIfMissing :: MonadIO m + => Bool -- ^ Create its parents too? + -> Path b Dir -- ^ The path to the directory you want to make + -> m () +createDirIfMissing p = liftD (D.createDirectoryIfMissing p) + +-- | @'removeDir' 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]@ + +removeDir :: MonadIO m => Path b Dir -> m () +removeDir = liftD D.removeDirectory + +-- | @'removeDirRecur' dir@ removes an existing directory @dir@ together +-- with its contents and subdirectories. Within this directory, symbolic +-- links are removed without affecting their the targets. + +removeDirRecur :: MonadIO m => Path b Dir -> m () +removeDirRecur = liftD D.removeDirectoryRecursive + +-- |@'renameDir' 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 'removeDir'. 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, @renameDir@ 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]@ + +renameDir :: MonadIO m + => Path b1 Dir -- ^ Old name + -> Path b2 Dir -- ^ New name + -> m () +renameDir = liftD2 D.renameDirectory + +-- | @'listDir' dir@ returns a list of /all/ entries in @dir@ without the +-- special entries (@.@ and @..@). Entries are not sorted. +-- +-- 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]@ + +listDir :: (MonadIO m, MonadThrow m) + => Path b Dir -- ^ Directory to list + -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files +listDir path = do + bpath <- makeAbsolute path + raw <- liftD D.getDirectoryContents bpath + items <- forM (raw \\ [".", ".."]) $ \item -> do + let ipath = toFilePath bpath F. item + isDir <- liftIO (D.doesDirectoryExist ipath) + if isDir + then Left `liftM` parseAbsDir ipath + else Right `liftM` parseAbsFile ipath + return (lefts items, rights items) + +-- | Similar to 'listDir', but recursively traverses every sub-directory, +-- and collects all files and directories. This can fail with the same +-- exceptions as 'listDir'. + +listDirRecur :: (MonadIO m, MonadThrow m) + => Path b Dir -- ^ Directory to list + -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files +listDirRecur path = do + bpath <- makeAbsolute path + items <- listDir bpath + foldl' mappend items `liftM` mapM listDirRecur (fst items) + +-- | Copy directory recursively. This is not smart about symbolic links, but +-- tries to preserve permissions when possible. If destination directory +-- already exists, new files and sub-directories will complement its +-- structure, possibly overwriting old files if they happen to have the same +-- name as the new ones. + +copyDirRecur :: (MonadIO m, MonadCatch m) + => Path b0 Dir -- ^ Source + -> Path b1 Dir -- ^ Destination + -> m () +copyDirRecur src dest = do + bsrc <- makeAbsolute src + bdest <- makeAbsolute dest + (dirs, files) <- listDirRecur bsrc + mapM (swapParent bsrc bdest) dirs >>= zipWithM_ copyDir dirs + mapM (swapParent bsrc bdest) files >>= zipWithM_ copyFile files + +-- | A helper for 'copyDirRecur', copies directory preserving permissions +-- when possible. It /does not/ copies directory contents. + +copyDir :: (MonadIO m, MonadCatch m) + => Path Abs Dir -- ^ Source + -> Path Abs Dir -- ^ Destination + -> m () +copyDir src dest = do + createDirIfMissing True dest + ignoringIOErrors (copyPermissions src dest) + +-- | A helper for 'copyDirRecur' that replaces given path prefix with +-- another one. + +swapParent :: MonadThrow m + => Path Abs Dir -- ^ Original parent + -> Path Abs Dir -- ^ New parent + -> Path Abs t -- ^ Path to transform + -> m (Path Abs t) +swapParent old new path = (new ) `liftM` stripDir old path + +---------------------------------------------------------------------------- +-- Current working directory + +-- | Obtain the current working directory as an absolute path. +-- +-- In a multithreaded program, the current working directory is a global +-- state shared among all threads of the process. Therefore, when performing +-- filesystem operations from multiple threads, it is highly recommended to +-- use absolute rather than relative paths (see: 'makeAbsolute'). +-- +-- The operation may fail with: +-- +-- * 'HardwareFault' +-- A physical I\/O error has occurred. +-- @[EIO]@ +-- +-- * 'isDoesNotExistError' or 'NoSuchThing' +-- There is no path referring to the working directory. +-- @[EPERM, ENOENT, ESTALE...]@ +-- +-- * 'isPermissionError' or '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 working directory. + +getCurrentDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) +getCurrentDir = liftIO D.getCurrentDirectory >>= parseAbsDir + +-- | Change the working directory to the given path. +-- +-- In a multithreaded program, the current working directory is a global +-- state shared among all threads of the process. Therefore, when performing +-- filesystem operations from multiple threads, it is highly recommended to +-- use absolute rather than relative paths (see: 'makeAbsolute'). +-- +-- 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' or 'NoSuchThing' +-- The directory does not exist. +-- @[ENOENT, ENOTDIR]@ +-- +-- * 'isPermissionError' or 'PermissionDenied' +-- The process has insufficient privileges to perform the operation. +-- @[EACCES]@ +-- +-- * 'UnsupportedOperation' +-- The operating system has no notion of current working directory, or the +-- working directory cannot be dynamically changed. +-- +-- * 'InappropriateType' +-- The path refers to an existing non-directory object. +-- @[ENOTDIR]@ + +setCurrentDir :: MonadIO m => Path b Dir -> m () +setCurrentDir = liftD D.setCurrentDirectory + +-- | Run an 'IO' action with the given working directory and restore the +-- original working directory afterwards, even if the given action fails due +-- to an exception. +-- +-- The operation may fail with the same exceptions as 'getCurrentDir' and +-- 'setCurrentDir'. + +withCurrentDir :: (MonadIO m, MonadMask m) + => Path b Dir -- ^ Directory to execute in + -> m a -- ^ Action to be executed + -> m a +withCurrentDir dir action = + bracket getCurrentDir setCurrentDir $ const (setCurrentDir dir >> action) + +---------------------------------------------------------------------------- +-- Pre-defined directories + +-- | 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 'getAppUserDataDir' instead. +-- +-- On Unix, 'getHomeDir' returns the value of the @HOME@ environment +-- variable. On Windows, the system is queried for a suitable path; a +-- typical path might be @C:\/Users\//\/@. +-- +-- 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. + +getHomeDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) +getHomeDir = liftIO D.getHomeDirectory >>= parseAbsDir + +-- | Obtain the path to a special directory for storing user-specific +-- application data (traditional Unix location). +-- +-- The argument is usually the name of the application. Since it will be +-- integrated into the path, it must consist of valid path characters. +-- +-- * On Unix-like systems, the path is @~\/./\/@. +-- * On Windows, the path is @%APPDATA%\//\/@ +-- (e.g. @C:\/Users\//\/\/AppData\/Roaming\//\/@) +-- +-- Note: the directory may not actually exist, in which case you would need +-- to create it. It is expected that the parent directory exists and is +-- writable. +-- +-- 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. + +getAppUserDataDir :: (MonadIO m, MonadThrow m) + => Path File Dir -- ^ A relative path that is appended to the path + -> m (Path Abs Dir) +getAppUserDataDir = (>>= parseAbsDir) . liftD D.getAppUserDataDirectory + +-- | 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 'getAppUserDataDir' instead. +-- +-- On Unix, 'getUserDocsDir' returns the value of the @HOME@ environment +-- variable. On Windows, the system is queried for a suitable path; a +-- typical path might be @C:\/Users\//\/\/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. + +getUserDocsDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) +getUserDocsDir = liftIO D.getUserDocumentsDirectory >>= parseAbsDir + +-- | Returns the current directory for temporary files. +-- +-- On Unix, 'getTempDir' 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. + +getTempDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) +getTempDir = liftIO D.getTemporaryDirectory >>= parseAbsDir + +---------------------------------------------------------------------------- +-- Path transformation + +-- | Closed type-family describing how to get absolute version of given +-- 'Path'. + +type family AbsPath path where + AbsPath (Path b File) = Path Abs File + AbsPath (Path b Dir) = Path Abs Dir + +-- | Class of things ('Path's) that can be canonicalized and made absolute. + +class AnyPath path where + + -- | Make a path absolute and remove as many indirections from it as + -- possible. Indirections include the two special directories @.@ and + -- @..@, as well as any symbolic links. The input path need not point to + -- an existing file or directory. + -- + -- __Note__: if you require only an absolute path, use 'makeAbsolute' + -- instead. Most programs need not care about whether a path contains + -- symbolic links. + -- + -- Due to the fact that symbolic links and @..@ are dependent on the state + -- of the existing filesystem, the function can only make a conservative, + -- best-effort attempt. Nevertheless, if the input path points to an + -- existing file or directory, then the output path shall also point to + -- the same file or directory. + -- + -- Formally, symbolic links and @..@ are removed from the longest prefix + -- of the path that still points to an existing file. The function is not + -- atomic, therefore concurrent changes in the filesystem may lead to + -- incorrect results. + -- + -- (Despite the name, the function does not guarantee canonicity of the + -- returned path due to the presence of hard links, mount points, etc.) + -- + -- Similar to 'normalise', an empty path is equivalent to the current + -- directory. + -- + -- /Known bug(s)/: on Windows, the function does not resolve symbolic links. + + canonicalizePath :: (MonadIO m, MonadThrow m) => path -> m (AbsPath path) + + -- | Make a path absolute by prepending the current directory (if it isn't + -- already absolute) and applying 'normalise' to the result. + -- + -- If the path is already absolute, the operation never fails. Otherwise, + -- the operation may fail with the same exceptions as + -- 'getCurrentDirectory'. + + makeAbsolute :: (MonadIO m, MonadThrow m) => path -> m (AbsPath path) + +instance AnyPath (Path b File) where + canonicalizePath = liftD D.canonicalizePath >=> parseAbsFile + makeAbsolute = liftD D.makeAbsolute >=> parseAbsFile + +instance AnyPath (Path b Dir) where + canonicalizePath = liftD D.canonicalizePath >=> parseAbsDir + makeAbsolute = liftD D.makeAbsolute >=> parseAbsDir + +---------------------------------------------------------------------------- +-- Actions on files + +-- | @'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 :: MonadIO m => Path b File -> m () +removeFile = liftD D.removeFile + +-- | @'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 :: MonadIO m + => Path b File -- ^ Original location + -> Path b File -- ^ New location + -> m () +renameFile = liftD2 D.renameFile + +-- | @'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 :: MonadIO m + => Path b File -- ^ Original location + -> Path b File -- ^ Where to put copy + -> m () +copyFile = liftD2 D.copyFile + +-- | Given an executable file name, search for such file in the directories +-- listed in system @PATH@. The returned value is the path to the found +-- executable or 'Nothing' if an executable with the given name was not +-- found. For example ('findExecutable' \"ghc\") gives you the path to GHC. +-- +-- The path returned by 'findExecutable' corresponds to the +-- program that would be executed by 'System.Process.createProcess' +-- when passed the same string (as a RawCommand, not a ShellCommand). +-- +-- On Windows, 'findExecutable' calls the Win32 function 'SearchPath', which +-- may search other places before checking the directories in @PATH@. Where +-- it actually searches depends on registry settings, but notably includes +-- the directory containing the current executable. See +-- for more details. + +findExecutable :: MonadIO m + => Path Rel File -- ^ Executable file name + -> m (Maybe (Path Abs File)) -- ^ Path to found executable +findExecutable = liftM (>>= parseAbsFile) . liftD D.findExecutable + +-- | Search through the given set of directories for the given file. + +findFile :: (MonadIO m, MonadThrow m) + => [Path b Dir] -- ^ Set of directories to search in + -> Path Rel File -- ^ Filename of interest + -> m (Maybe (Path Abs File)) -- ^ Absolute path to file (if found) +findFile dirs file = listToMaybe `liftM` findFiles dirs file + +-- | Search through the given set of directories for the given file and +-- return a list of paths where the given file exists. + +findFiles :: (MonadIO m, MonadThrow m) + => [Path b Dir] -- ^ Set of directories to search in + -> Path Rel File -- ^ Filename of interest + -> m [Path Abs File] -- ^ Absolute paths to all found files +findFiles = findFilesWith (const (return True)) + +-- | Search through the given set of directories for the given file and with +-- the given property (usually permissions) and return a list of paths where +-- the given file exists and has the property. + +findFilesWith :: (MonadIO m, MonadThrow m) + => (Path Abs File -> m Bool) -- ^ How to test the files + -> [Path b Dir] -- ^ Set of directories to search in + -> Path Rel File -- ^ Filename of interest + -> m [Path Abs File] -- ^ Absolute paths to all found files +findFilesWith _ [] _ = return [] +findFilesWith f (d:ds) file = do + bfile <- ( file) `liftM` makeAbsolute d + exist <- doesFileExist file + b <- if exist then f bfile else return False + if b + then (bfile:) `liftM` findFilesWith f ds file + else findFilesWith f ds file + +---------------------------------------------------------------------------- +-- Existence tests + +-- | The operation 'doesFileExist' returns 'True' if the argument file +-- exists and is not a directory, and 'False' otherwise. + +doesFileExist :: MonadIO m => Path b File -> m Bool +doesFileExist = liftD D.doesFileExist + +-- | The operation 'doesDirExist' returns 'True' if the argument file exists +-- and is either a directory or a symbolic link to a directory, and 'False' +-- otherwise. + +doesDirExist :: MonadIO m => Path b Dir -> m Bool +doesDirExist = liftD D.doesDirectoryExist + +-- | Check if there is a file or directory on specified path. + +isLocationOccupied :: MonadIO m => Path b t -> m Bool +isLocationOccupied path = do + let fp = toFilePath path + file <- liftIO (D.doesFileExist fp) + dir <- liftIO (D.doesDirectoryExist fp) + return (file || dir) + +---------------------------------------------------------------------------- +-- Permissions + +-- | 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 :: MonadIO m => Path b t -> m D.Permissions +getPermissions = liftD D.getPermissions + +-- | 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 :: MonadIO m => Path b t -> D.Permissions -> m () +setPermissions = liftD2' D.setPermissions + +-- | Set permissions for the object found on second given path so they match +-- permissions of the object on the first path. + +copyPermissions :: MonadIO m + => Path b0 t0 -- ^ From where to copy + -> Path b1 t1 -- ^ What to modify + -> m () +copyPermissions = liftD2 D.copyPermissions + +---------------------------------------------------------------------------- +-- Timestamps + +#if MIN_VERSION_directory(1,2,3) + +-- | Obtain the time at which the file or directory was last accessed. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to read +-- the access time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Caveat for POSIX systems: This function returns a timestamp with +-- sub-second resolution only if this package is compiled against +-- @unix-2.6.0.0@ or later and the underlying filesystem supports them. + +getAccessTime :: MonadIO m => Path b t -> m UTCTime +getAccessTime = liftD D.getAccessTime + +-- | Change the time at which the file or directory was last accessed. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to alter the +-- access time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Some caveats for POSIX systems: +-- +-- * Not all systems support @utimensat@, in which case the function can +-- only emulate the behavior by reading the modification time and then +-- setting both the access and modification times together. On systems +-- where @utimensat@ is supported, the access time is set atomically with +-- nanosecond precision. +-- +-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the +-- function would not be able to set timestamps with sub-second +-- resolution. In this case, there would also be loss of precision in the +-- modification time. + +setAccessTime :: MonadIO m => Path b t -> UTCTime -> m () +setAccessTime = liftD2' D.setAccessTime + +-- | Change the time at which the file or directory was last modified. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to alter the +-- modification time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Some caveats for POSIX systems: +-- +-- * Not all systems support @utimensat@, in which case the function can +-- only emulate the behavior by reading the access time and then setting +-- both the access and modification times together. On systems where +-- @utimensat@ is supported, the modification time is set atomically with +-- nanosecond precision. +-- +-- * If compiled against a version of @unix@ prior to @2.7.0.0@, the +-- function would not be able to set timestamps with sub-second +-- resolution. In this case, there would also be loss of precision in the +-- access time. + +setModificationTime :: MonadIO m => Path b t -> UTCTime -> m () +setModificationTime = liftD2' D.setAccessTime + +#endif + +-- | Obtain the time at which the file or directory was last modified. +-- +-- The operation may fail with: +-- +-- * 'isPermissionError' if the user is not permitted to read +-- the modification time; or +-- +-- * 'isDoesNotExistError' if the file or directory does not exist. +-- +-- Caveat for POSIX systems: This function returns a timestamp with +-- sub-second resolution only if this package is compiled against +-- @unix-2.6.0.0@ or later and the underlying filesystem supports them. + +getModificationTime :: MonadIO m => Path b t -> m UTCTime +getModificationTime = liftD D.getModificationTime + +---------------------------------------------------------------------------- +-- Helpers + +-- | Lift action in 'IO' that takes 'FilePath' into action in slightly more +-- abstract monad that takes 'Path'. + +liftD :: MonadIO m + => (FilePath -> IO a) -- ^ Original action + -> Path b t -- ^ 'Path' argument + -> m a -- ^ Lifted action +liftD m = liftIO . m . toFilePath + +-- | Similar to 'liftD' for functions with arity 2. + +liftD2 :: MonadIO m + => (FilePath -> FilePath -> IO a) -- ^ Original action + -> Path b0 t0 -- ^ First 'Path' argument + -> Path b1 t1 -- ^ Second 'Path' argument + -> m a +liftD2 m a b = liftIO $ m (toFilePath a) (toFilePath b) + +-- | Similar to 'liftD2', but allows to pass second argument. + +liftD2' :: MonadIO m + => (FilePath -> v -> IO a) -- ^ Original action + -> Path b0 t0 -- ^ First 'Path' argument + -> v -- ^ Second argument + -> m a +liftD2' m a v = liftIO $ m (toFilePath a) v + +-- | Perform specified action ignoring IO exceptions it may throw. + +ignoringIOErrors :: MonadCatch m => m () -> m () +ignoringIOErrors ioe = ioe `catch` handler + where + handler :: MonadThrow m => IOError -> m () + handler = const (return ()) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,20 @@ +# Path IO + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Hackage](https://img.shields.io/hackage/v/path-io.svg?style=flat)](https://hackage.haskell.org/package/path-io) +[![Stackage Nightly](http://stackage.org/package/path-io/badge/nightly)](http://stackage.org/nightly/package/path-io) +[![Build Status](https://travis-ci.org/mrkkrp/path-io.svg?branch=master)](https://travis-ci.org/mrkkrp/path-io) + +This package provides interface to +[`directory`](https://hackage.haskell.org/package/directory) package for +users of Chris Done's [`path`](https://hackage.haskell.org/package/path). It +also implements some missing stuff like recursive scanning and copying of +directories. + +Consult Haddocks for usage, which should be trivial. + +## License + +Copyright © 2016 Mark Karpov + +Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/path-io.cabal b/path-io.cabal new file mode 100644 --- /dev/null +++ b/path-io.cabal @@ -0,0 +1,71 @@ +-- +-- Cabal configuration for ‘path-io’. +-- +-- Copyright © 2016 Mark Karpov +-- +-- 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 Mark Karpov nor the names of 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 “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 HOLDERS 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. + +name: path-io +version: 0.1.0 +cabal-version: >= 1.10 +license: BSD3 +license-file: LICENSE.md +author: Mark Karpov +maintainer: Mark Karpov +homepage: https://github.com/mrkkrp/path-io +bug-reports: https://github.com/mrkkrp/path-io/issues +category: System, Filesystem +synopsis: Interface to ‘directory’ package for users of ‘path’ +build-type: Simple +description: Interface to ‘directory’ package for users of ‘path’. +extra-source-files: CHANGELOG.md + , README.md + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + build-depends: base >= 4.7 && < 5 + , directory >= 1.2.2.0 + , exceptions >= 0.8 + , filepath >= 1.2 + , path >= 0.5 + , time >= 1.4 + , transformers >= 0.3 + exposed-modules: Path.IO + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/mrkkrp/path-io.git