path-io-1.6.0/0000755000000000000000000000000007346545000011250 5ustar0000000000000000path-io-1.6.0/CHANGELOG.md0000644000000000000000000001157307346545000013070 0ustar0000000000000000## Path IO 1.6.0 * Changed how `copyDirRecur` and `copyDirRecur'` functions work. Previously, the functions created empty directories in the destination directory when the source directory contained directory symlinks. The symlinked directories were not recursively traversed. It also copied symlinked files creating normal regular files in the target directory as the result. This is fixed so that the function now behaves much like the `cp` utility, not traversing symlinked directories, but recreating symlinks in the target directory according to their targets in the source directory. * Fixed a bug in `createDirLink` which would always fail complaining that its destination location does not exist. * Dropped support for GHC 8.2. ## Path IO 1.5.0 * Dropped support for GHC 8.0 and older. * Added new functions: `getXdgDirList`, `createFileLink`, `createDirLink`, `removeDirLink`, `getSymlinkTarget`. ## Path IO 1.4.2 * Fixed various bugs in `listDirRecurRel`, `walkDirRel`, and `walkDirAccumRel` and clarified their behavior in the docs. ## Path IO 1.4.1 * Fixed a bug in `walkDirRel` that resulted in `NotAProperPrefix` exception every time the function was called. ## Path IO 1.4.0 * Added relative versions of some actions: `listDirRel`, `listDirRecurRel`, `walkDirRel`, and `walkDirAccumRel`. * Dropped support for GHC 7.8. ## Path IO 1.3.3 * (Hopefully) fixed test suite failure with Cabal 2.0 and GHC 8.2.1. ## Path IO 1.3.2 * Reduce a number of `(MonadIO m, MonadThrow m)` constraints to just `MonadIO m` [#27](https://github.com/mrkkrp/path-io/issues/27) ## Path IO 1.3.1 * Made `listDirRecur` faster for deep directory trees. ## Path IO 1.3.0 * Change the default behavior of recursive traversal APIs to not follow symbolic links. The change affects the following functions: `listDirRecur`, `copyDirRecur`, and `copyDirRecur'`. * Add `isSymlink` which allows to test whether a path is a symbolic link. * Move the type functions `AbsPath` and `RelPath` to the `AnyPath` type class (previously they were standalone closed type families, now they are associated types of `AnyPath`). * Improved the documentation and metadata. ## Path IO 1.2.3 * Allowed `time-1.7`. ## Path IO 1.2.2 * Fixed a bug in `setModificationTime` function that previously called `setAccessTime` instead of `setModificationTime` from `directory`. * Added notes to all pieces of API that are conditional (some functions are only available if `directory-1.2.3.0` or later is used, now it's mentioned for every such function explicitely). ## Path IO 1.2.1 * Allowed `directory-1.3.0.0`. * Added `getXdgDir`. Only available of `directory-1.2.3.0` or later is used. * Various cosmetic improvements. ## Path IO 1.2.0 * Added `walkDir` function to traverse a directory tree with a handler. * Added `walkDirAccum` function which is like `walkDir` but also accepts an output writer and returns the accumulated output. * All recursive traversal functions (existing and new) now safely handle directory loops due to symbolic or hard links. * Added “since” notes to public functions in API. ## Path IO 1.1.0 * Fixed bug in `copyDirRecur` when it was unable to fully copy read-only directories. * Added `copyDirRecur'` function that works just like `copyDirRecur`, but does not preserve directory permissions. ## Path IO 1.0.1 * Fixed bug in `copyDirRecur` for non-existing destination paths when directory to copy does not contain sub-directories. * Made `copyDirRecur` try to copy permissions for destination directory too (previously it only tried to copy them for sub-directories). ## Path IO 1.0.0 * Changed signature of `getAppUserDataDir`, so it takes `String` as the first argument. * Removed deprecated `forgivingAbsence'` function. * Made `findFile` lazier, it stops searching as soon as a file is found. * Added some tests. ## Path IO 0.3.1 * Introduced synonym for `forgivingAbsence'` — `ignoringAbsence`. `forgivingAbsence'` is deprecated now, but it's still there. * Added a handy shortcut `ensureDir` that is defined as `ensureDir = createDirIfMissing True`. * Made `getHomeDir` and `getTempDir` more robust when they are influenced by values of environment variables. ## Path IO 0.3.0 * Added `forgivingAbsence`, `resolveFile`, and `resolveDir` functions, so the package now provides all functionality that `Path.IO` module in Stack has. * Added closed type family `RelPath`, `makeRelative`, and `makeRelativeToCurrentDir` functions. * Fixed signature of `getAppUserDataDir`. ## Path IO 0.2.0 * Added functions from `temporary`: `withTempFile`, `withTempDir`, `withSystemTempFile`, `withSystemTempDir`, `openTempFile`, `openBinaryTempFile`, and `createTempDir`. `temporary` is a lightweight and ubiquitous package, so depending on it should be OK. ## Path IO 0.1.1 * Fixed type signatures of `renameFile` and `copyFile`. ## Path IO 0.1.0 * Initial release. path-io-1.6.0/LICENSE.md0000644000000000000000000000265607346545000012665 0ustar0000000000000000Copyright © 2016–present 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. path-io-1.6.0/Path/0000755000000000000000000000000007346545000012144 5ustar0000000000000000path-io-1.6.0/Path/IO.hs0000644000000000000000000016306407346545000013021 0ustar0000000000000000-- | -- Module : Path.IO -- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable -- -- This module provides an interface to "System.Directory" for users of the -- "Path" module. It also implements commonly used primitives like recursive -- scanning and copying of directories, working with temporary -- files\/directories, etc. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} module Path.IO ( -- * Actions on directories createDir , createDirIfMissing , ensureDir , removeDir , removeDirRecur , renameDir , listDir , listDirRel , listDirRecur , listDirRecurRel , copyDirRecur , copyDirRecur' -- ** Walking directory trees , WalkAction (..) , walkDir , walkDirRel , walkDirAccum , walkDirAccumRel -- ** Current working directory , getCurrentDir , setCurrentDir , withCurrentDir -- * Pre-defined directories , getHomeDir , getAppUserDataDir , getUserDocsDir , getTempDir , D.XdgDirectory (..) , getXdgDir , D.XdgDirectoryList (..) , getXdgDirList -- * Path transformation , AnyPath (..) , resolveFile , resolveFile' , resolveDir , resolveDir' -- * Actions on files , removeFile , renameFile , copyFile , findExecutable , findFile , findFiles , findFilesWith -- * Symbolic links , createFileLink , createDirLink , removeDirLink , getSymlinkTarget , isSymlink -- * Temporary files and directories , withTempFile , withTempDir , withSystemTempFile , withSystemTempDir , openTempFile , openBinaryTempFile , createTempDir -- * Existence tests , doesFileExist , doesDirExist , isLocationOccupied , forgivingAbsence , ignoringAbsence -- * 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 , getAccessTime , setAccessTime , setModificationTime , getModificationTime ) where import Control.Arrow ((***)) import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Control.Monad.Trans.Writer.Lazy (WriterT, execWriterT, tell) import Data.Either (lefts, rights) import Data.Kind (Type) import Data.List ((\\)) import Data.Time (UTCTime) import Path import System.IO (Handle) import System.IO.Error (isDoesNotExistError) import qualified Data.DList as DList import qualified Data.Set as S import qualified System.Directory as D import qualified System.FilePath as F import qualified System.IO.Temp as T import qualified System.PosixCompat.Files as P ---------------------------------------------------------------------------- -- 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) -- | Ensure that a directory exists creating it and its parent directories -- if necessary. This is just a handy shortcut: -- -- > ensureDir = createDirIfMissing True -- -- @since 0.3.1 ensureDir :: MonadIO m => Path b Dir -> m () ensureDir = createDirIfMissing True -- | @'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 sub-directories. Within this directory, symbolic -- links are removed without affecting their 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 b0 Dir -- ^ Old name -> Path b1 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 => Path b Dir -- ^ Directory to list -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files listDir path = do bpath <- makeAbsolute path (subdirs, files) <- listDirRel bpath return ( (bpath ) <$> subdirs , (bpath ) <$> files ) -- | The same as 'listDir' but returns relative paths. -- -- @since 1.4.0 listDirRel :: MonadIO m => Path b Dir -- ^ Directory to list -> m ([Path Rel Dir], [Path Rel File]) -- ^ Sub-directories and files listDirRel path = liftIO $ do raw <- liftD D.getDirectoryContents path items <- forM (raw \\ [".", ".."]) $ \item -> do isDir <- liftIO (D.doesDirectoryExist $ toFilePath path F. item) if isDir then Left <$> parseRelDir item else Right <$> parseRelFile item return (lefts items, rights items) -- | Similar to 'listDir', but recursively traverses every sub-directory -- /excluding symbolic links/, and returns all files and directories found. -- This can fail with the same exceptions as 'listDir'. -- -- __Note__: before version /1.3.0/, this function followed symlinks. listDirRecur :: MonadIO m => Path b Dir -- ^ Directory to list -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files listDirRecur dir = (DList.toList *** DList.toList) <$> walkDirAccum (Just excludeSymlinks) writer dir where excludeSymlinks _ subdirs _ = WalkExclude <$> filterM isSymlink subdirs writer _ ds fs = return ( DList.fromList ds , DList.fromList fs ) -- | The same as 'listDirRecur' but returns paths that are relative to the -- given directory. -- -- @since 1.4.2 listDirRecurRel :: MonadIO m => Path b Dir -- ^ Directory to list -> m ([Path Rel Dir], [Path Rel File]) -- ^ Sub-directories and files listDirRecurRel dir = (DList.toList *** DList.toList) <$> walkDirAccumRel (Just excludeSymlinks) writer dir where excludeSymlinks tdir subdirs _ = WalkExclude <$> filterM (isSymlink . (dir ) . (tdir )) subdirs writer tdir ds fs = return ( DList.fromList ((tdir ) <$> ds) , DList.fromList ((tdir ) <$> fs) ) -- | Copies a directory recursively. It /does not/ follow symbolic links and -- preserves permissions when possible. If the destination directory already -- exists, new files and sub-directories complement its structure, possibly -- overwriting old files if they happen to have the same name as the new -- ones. -- -- __Note__: before version /1.3.0/, this function followed symlinks. -- -- __Note__: before version /1.6.0/, the function created empty directories -- in the destination directory when the source directory contained -- directory symlinks. The symlinked directories were not recursively -- traversed. It also copied symlinked files creating normal regular files -- in the target directory as the result. This was fixed in the version -- /1.6.0/ so that the function now behaves much like the @cp@ utility, not -- traversing symlinked directories, but recreating symlinks in the target -- directory according to their targets in the source directory. copyDirRecur :: (MonadIO m, MonadCatch m) => Path b0 Dir -- ^ Source -> Path b1 Dir -- ^ Destination -> m () copyDirRecur = copyDirRecurGen True -- | The same as 'copyDirRecur', but it /does not/ preserve directory -- permissions. This may be useful, for example, if the directory you want -- to copy is “read-only”, but you want your copy to be editable. -- -- @since 1.1.0 -- -- __Note__: before version /1.3.0/, this function followed symlinks. -- -- __Note__: before version /1.6.0/, the function created empty directories -- in the destination directory when the source directory contained -- directory symlinks. The symlinked directories were not recursively -- traversed. It also copied symlinked files creating normal regular files -- in the target directory as the result. This was fixed in the version -- /1.6.0/ so that the function now behaves much like the @cp@ utility, not -- traversing symlinked directories, but recreating symlinks in the target -- directory according to their targets in the source directory. copyDirRecur' :: (MonadIO m, MonadCatch m) => Path b0 Dir -- ^ Source -> Path b1 Dir -- ^ Destination -> m () copyDirRecur' = copyDirRecurGen False -- | Generic version of 'copyDirRecur'. The first argument controls whether -- to preserve directory permissions or not. /Does not/ follow symbolic -- links. Internal function. copyDirRecurGen :: MonadIO m => Bool -- ^ Should we preserve directory permissions? -> Path b0 Dir -- ^ Source -> Path b1 Dir -- ^ Destination -> m () copyDirRecurGen preserveDirPermissions src dest = liftIO $ do bsrc <- makeAbsolute src bdest <- makeAbsolute dest (dirs, files) <- listDirRecur bsrc let swapParent :: Path Abs Dir -> Path Abs Dir -> Path Abs t -> IO (Path Abs t) swapParent old new path = (new ) <$> stripProperPrefix old path ensureDir bdest forM_ dirs $ \srcDir -> do destDir <- swapParent bsrc bdest srcDir dirIsSymlink <- isSymlink srcDir if dirIsSymlink then do target <- getSymlinkTarget srcDir D.createDirectoryLink target $ F.dropTrailingPathSeparator (toFilePath destDir) else ensureDir destDir when preserveDirPermissions $ ignoringIOErrors (copyPermissions srcDir destDir) forM_ files $ \srcFile -> do destFile <- swapParent bsrc bdest srcFile fileIsSymlink <- isSymlink srcFile if fileIsSymlink then do target <- getSymlinkTarget srcFile D.createFileLink target (toFilePath destFile) else copyFile srcFile destFile when preserveDirPermissions $ ignoringIOErrors (copyPermissions bsrc bdest) ---------------------------------------------------------------------------- -- Walking directory trees -- Recursive directory walk functionality, with a flexible API and avoidance -- of loops. Following are some notes on the design. -- -- Callback handler API: -- -- The callback handler interface is designed to be highly flexible. There are -- two possible alternative ways to control the traversal: -- -- * In the context of the parent dir, decide which subdirs to descend into. -- * In the context of the subdir, decide whether to traverse the subdir or not. -- -- We choose the first approach here since it is more flexible and can -- achieve everything that the second one can. The additional benefit with -- this is that we can use the parent dir context efficiently instead of -- each child looking at the parent context independently. -- -- To control which subdirs to descend we use a 'WalkExclude' API instead of -- a “WalkInclude” type of API so that the handlers cannot accidentally ask -- us to descend a dir which is not a subdir of the directory being walked. -- -- Avoiding Traversal Loops: -- -- There can be loops in the path being traversed due to subdirectory -- symlinks or filesystem corruptions can cause loops by creating directory -- hardlinks. Also, if the filesystem is changing while we are traversing -- then we might be going in loops due to the changes. -- -- We record the path we are coming from to detect the loops. If we end up -- traversing the same directory again we are in a loop. -- | Action returned by the traversal handler function. The action controls -- how the traversal will proceed. -- -- __Note__: in version /1.4.0/ the type was adjusted to have the @b@ type -- parameter. -- -- @since 1.2.0 data WalkAction b = WalkFinish -- ^ Finish the entire walk altogether | WalkExclude [Path b Dir] -- ^ List of sub-directories to exclude from -- descending deriving (Eq, Show) -- | Traverse a directory tree using depth first pre-order traversal, -- calling a handler function at each directory node traversed. The absolute -- paths of the parent directory, sub-directories and the files in the -- directory are provided as arguments to the handler. -- -- The function is capable of detecting and avoiding traversal loops in the -- directory tree. Note that the traversal follows symlinks by default, an -- appropriate traversal handler can be used to avoid that when necessary. -- -- @since 1.2.0 walkDir :: MonadIO m => (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m (WalkAction Abs)) -- ^ Handler (@dir -> subdirs -> files -> 'WalkAction'@) -> Path b Dir -- ^ Directory where traversal begins -> m () walkDir handler topdir = void $ makeAbsolute topdir >>= walkAvoidLoop S.empty where walkAvoidLoop traversed curdir = do mRes <- checkLoop traversed curdir case mRes of Nothing -> return $ Just () Just traversed' -> walktree traversed' curdir walktree traversed curdir = do (subdirs, files) <- listDir curdir action <- handler curdir subdirs files case action of WalkFinish -> return Nothing WalkExclude xdirs -> case subdirs \\ xdirs of [] -> return $ Just () ds -> runMaybeT $ mapM_ (MaybeT . walkAvoidLoop traversed) ds checkLoop traversed dir = do st <- liftIO $ P.getFileStatus (fromAbsDir dir) let ufid = (P.deviceID st, P.fileID st) return $ if S.member ufid traversed then Nothing else Just (S.insert ufid traversed) -- | The same as 'walkDir' but uses relative paths. The handler is given -- @dir@, directory relative to the directory where traversal begins. -- Sub-directories and files are relative to @dir@. -- -- @since 1.4.2 walkDirRel :: MonadIO m => ( Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel) ) -- ^ Handler (@dir -> subdirs -> files -> 'WalkAction'@) -> Path b Dir -- ^ Directory where traversal begins -> m () walkDirRel handler topdir' = do topdir <- makeAbsolute topdir' let walkAvoidLoop traversed curdir = do mRes <- checkLoop traversed (topdir curdir) case mRes of Nothing -> return $ Just () Just traversed' -> walktree traversed' curdir walktree traversed curdir = do (subdirs, files) <- listDirRel (topdir curdir) action <- handler curdir subdirs files case action of WalkFinish -> return Nothing WalkExclude xdirs -> case subdirs \\ xdirs of [] -> return $ Just () ds -> runMaybeT $ mapM_ (MaybeT . walkAvoidLoop traversed) ((curdir ) <$> ds) checkLoop traversed dir = do st <- liftIO $ P.getFileStatus (fromAbsDir dir) let ufid = (P.deviceID st, P.fileID st) return $ if S.member ufid traversed then Nothing else Just (S.insert ufid traversed) void (walkAvoidLoop S.empty $(mkRelDir ".")) -- | Similar to 'walkDir' but accepts a 'Monoid'-returning output writer as -- well. Values returned by the output writer invocations are accumulated -- and returned. -- -- Both, the descend handler as well as the output writer can be used for -- side effects but keep in mind that the output writer runs before the -- descend handler. -- -- @since 1.2.0 walkDirAccum :: (MonadIO m, Monoid o) => Maybe (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m (WalkAction Abs)) -- ^ Descend handler (@dir -> subdirs -> files -> 'WalkAction'@), -- descend the whole tree if omitted -> (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m o) -- ^ Output writer (@dir -> subdirs -> files -> o@) -> Path b Dir -- ^ Directory where traversal begins -> m o -- ^ Accumulation of outputs generated by the output writer invocations walkDirAccum = walkDirAccumWith walkDir -- | The same as 'walkDirAccum' but uses relative paths. The handler and -- writer are given @dir@, directory relative to the directory where -- traversal begins. Sub-directories and files are relative to @dir@. -- -- @since 1.4.2 walkDirAccumRel :: (MonadIO m, Monoid o) => Maybe (Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)) -- ^ Descend handler (@dir -> subdirs -> files -> 'WalkAction'@), -- descend the whole tree if omitted -> (Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m o) -- ^ Output writer (@dir -> subdirs -> files -> o@) -> Path b Dir -- ^ Directory where traversal begins -> m o -- ^ Accumulation of outputs generated by the output writer invocations walkDirAccumRel = walkDirAccumWith walkDirRel -- | Non-public helper function for defining accumulating walking actions. walkDirAccumWith :: (MonadIO m, Monoid o) => ( ( Path a Dir -> [Path a Dir] -> [Path a File] -> WriterT o m (WalkAction a) ) -> Path b Dir -> WriterT o m () ) -- ^ The walk function we use -> Maybe (Path a Dir -> [Path a Dir] -> [Path a File] -> m (WalkAction a)) -- ^ Descend handler (@dir -> subdirs -> files -> 'WalkAction'@), -- descend the whole tree if omitted -> (Path a Dir -> [Path a Dir] -> [Path a File] -> m o) -- ^ Output writer (@dir -> subdirs -> files -> o@) -> Path b Dir -- ^ Directory where traversal begins -> m o -- ^ Accumulation of outputs generated by the output writer invocations walkDirAccumWith walkF dHandler writer topdir = execWriterT (walkF handler topdir) where handler dir subdirs files = do res <- lift $ writer dir subdirs files tell res case dHandler of Just h -> lift $ h dir subdirs files Nothing -> return (WalkExclude []) ---------------------------------------------------------------------------- -- 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 => 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 -- | Return 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 => m (Path Abs Dir) getHomeDir = liftIO D.getHomeDirectory >>= resolveDir' -- | 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 => String -- ^ Name of application (used in path construction) -> m (Path Abs Dir) getAppUserDataDir = liftIO . (>>= parseAbsDir) . D.getAppUserDataDirectory -- | Return 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 => m (Path Abs Dir) getUserDocsDir = liftIO $ D.getUserDocumentsDirectory >>= parseAbsDir -- | Return 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 => m (Path Abs Dir) getTempDir = liftIO D.getTemporaryDirectory >>= resolveDir' -- | Obtain the paths to special directories for storing user-specific -- application data, configuration, and cache files, conforming to the -- . -- Compared with 'getAppUserDataDir', this function provides a more -- fine-grained hierarchy as well as greater flexibility for the user. -- -- It also works on Windows, although in that case 'D.XdgData' and -- 'D.XdgConfig' will map to the same directory. -- -- Note: The directory may not actually exist, in which case you would need -- to create it with file mode @700@ (i.e. only accessible by the owner). -- -- Note also: this is a piece of conditional API, only available if -- @directory-1.2.3.0@ or later is used. -- -- @since 1.2.1 getXdgDir :: MonadIO m => D.XdgDirectory -- ^ Which special directory -> Maybe (Path Rel Dir) -- ^ A relative path that is appended to the path; if 'Nothing', the -- base path is returned -> m (Path Abs Dir) getXdgDir xdgDir suffix = liftIO $ (D.getXdgDirectory xdgDir $ maybe "" toFilePath suffix) >>= parseAbsDir -- | Similar to 'getXdgDir' but retrieves the entire list of XDG -- directories. -- -- On Windows, 'D.XdgDataDirs' and 'D.XdgConfigDirs' usually map to the same -- list of directories unless overridden. -- -- Refer to the docs of 'D.XdgDirectoryList' for more details. -- -- @since 1.5.0 getXdgDirList :: MonadIO m => D.XdgDirectoryList -- ^ Which special directory list -> m [Path Abs Dir] getXdgDirList xdgDirList = liftIO (D.getXdgDirectoryList xdgDirList >>= mapM parseAbsDir) ---------------------------------------------------------------------------- -- Path transformation -- | Class of things ('Path's) that can be canonicalized, made absolute, and -- made relative to a some base directory. class AnyPath path where -- | Type of absolute version of the given @path@. type AbsPath path :: Type -- | Type of relative version of the given @path@. type RelPath path :: Type -- | 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 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 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.) -- -- /Known bug(s)/: on Windows, the function does not resolve symbolic -- links. -- -- Please note that before version 1.2.3.0 of the @directory@ package, -- this function had unpredictable behavior on non-existent paths. canonicalizePath :: MonadIO m => path -> m (AbsPath path) -- | Make a path absolute by prepending the current directory (if it isn't -- already absolute) and applying 'F.normalise' to the result. -- -- If the path is already absolute, the operation never fails. Otherwise, -- the operation may fail with the same exceptions as 'getCurrentDir'. makeAbsolute :: MonadIO m => path -> m (AbsPath path) -- | Make a path relative to a given directory. -- -- @since 0.3.0 makeRelative :: MonadThrow m => Path Abs Dir -- ^ Base directory -> path -- ^ Path that will be made relative to base directory -> m (RelPath path) -- | Make a path relative to current working directory. -- -- @since 0.3.0 makeRelativeToCurrentDir :: MonadIO m => path -> m (RelPath path) instance AnyPath (Path b File) where type AbsPath (Path b File) = Path Abs File type RelPath (Path b File) = Path Rel File canonicalizePath = liftD $ D.canonicalizePath >=> parseAbsFile makeAbsolute = liftD $ D.makeAbsolute >=> parseAbsFile makeRelative b p = parseRelFile (F.makeRelative (toFilePath b) (toFilePath p)) makeRelativeToCurrentDir p = liftIO $ getCurrentDir >>= flip makeRelative p instance AnyPath (Path b Dir) where type AbsPath (Path b Dir) = Path Abs Dir type RelPath (Path b Dir) = Path Rel Dir canonicalizePath = liftD D.canonicalizePath >=> liftIO . parseAbsDir makeAbsolute = liftD D.makeAbsolute >=> liftIO . parseAbsDir makeRelative b p = parseRelDir (F.makeRelative (toFilePath b) (toFilePath p)) makeRelativeToCurrentDir p = liftIO $ getCurrentDir >>= flip makeRelative p -- | Append stringly-typed path to an absolute path and then canonicalize -- it. -- -- @since 0.3.0 resolveFile :: MonadIO m => Path Abs Dir -- ^ Base directory -> FilePath -- ^ Path to resolve -> m (Path Abs File) resolveFile b p = liftIO $ D.canonicalizePath (toFilePath b F. p) >>= parseAbsFile -- | The same as 'resolveFile', but uses current working directory. -- -- @since 0.3.0 resolveFile' :: MonadIO m => FilePath -- ^ Path to resolve -> m (Path Abs File) resolveFile' p = getCurrentDir >>= flip resolveFile p -- | The same as 'resolveFile', but for directories. -- -- @since 0.3.0 resolveDir :: MonadIO m => Path Abs Dir -- ^ Base directory -> FilePath -- ^ Path to resolve -> m (Path Abs Dir) resolveDir b p = liftIO $ D.canonicalizePath (toFilePath b F. p) >>= parseAbsDir -- | The same as 'resolveDir', but uses current working directory. -- -- @since 0.3.0 resolveDir' :: MonadIO m => FilePath -- ^ Path to resolve -> m (Path Abs Dir) resolveDir' p = getCurrentDir >>= flip resolveDir p ---------------------------------------------------------------------------- -- 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 b0 File -- ^ Original location -> Path b1 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 b0 File -- ^ Original location -> Path b1 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 = fmap (>>= parseAbsFile) . liftD D.findExecutable -- | Search through the given set of directories for the given file. findFile :: MonadIO 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 [] _ = return Nothing findFile (d:ds) file = do bfile <- ( file) <$> makeAbsolute d exist <- doesFileExist bfile if exist then return (Just bfile) else findFile ds 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 => [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 => (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) <$> makeAbsolute d exist <- doesFileExist file b <- if exist then f bfile else return False if b then (bfile:) <$> findFilesWith f ds file else findFilesWith f ds file ---------------------------------------------------------------------------- -- Symbolic links -- | Create a /file/ symbolic link. The target path can be either absolute -- or relative and need not refer to an existing file. The order of -- arguments follows the POSIX convention. -- -- To remove an existing file symbolic link, use 'removeFile'. -- -- Although the distinction between /file/ symbolic links and /directory/ -- symbolic links does not exist on POSIX systems, on Windows this is an -- intrinsic property of every symbolic link and cannot be changed without -- recreating the link. A file symbolic link that actually points to a -- directory will fail to dereference and vice versa. Moreover, creating -- symbolic links on Windows may require privileges unavailable to users -- outside the Administrators group. Portable programs that use symbolic -- links should take both into consideration. -- -- On Windows, the function is implemented using @CreateSymbolicLink@. Since -- 1.3.3.0, the @SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE@ flag is -- included if supported by the operating system. On POSIX, the function -- uses @symlink@ and is therefore atomic. -- -- Windows-specific errors: This operation may fail with -- 'System.IO.Error.permissionErrorType' if the user lacks the privileges to -- create symbolic links. It may also fail with -- 'System.IO.Error.illegalOperationErrorType' if the file system does not -- support symbolic links. -- -- @since 1.5.0 createFileLink :: MonadIO m => Path b0 File -- ^ Path to the target file -> Path b1 File -- ^ Path to the link to be created -> m () createFileLink = liftD2 D.createFileLink -- | Create a /directory/ symbolic link. The target path can be either -- absolute or relative and need not refer to an existing directory. The -- order of arguments follows the POSIX convention. -- -- To remove an existing directory symbolic link, use 'removeDirLink'. -- -- Although the distinction between /file/ symbolic links and /directory/ -- symbolic links does not exist on POSIX systems, on Windows this is an -- intrinsic property of every symbolic link and cannot be changed without -- recreating the link. A file symbolic link that actually points to a -- directory will fail to dereference and vice versa. Moreover, creating -- symbolic links on Windows may require privileges unavailable to users -- outside the Administrators group. Portable programs that use symbolic -- links should take both into consideration. -- -- On Windows, the function is implemented using @CreateSymbolicLink@ with -- @SYMBOLIC_LINK_FLAG_DIRECTORY@. Since 1.3.3.0, the -- @SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE@ flag is also included if -- supported by the operating system. On POSIX, this is an alias for -- 'createFileLink' and is therefore atomic. -- -- Windows-specific errors: This operation may fail with -- 'System.IO.Error.permissionErrorType' if the user lacks the privileges to -- create symbolic links. It may also fail with -- 'System.IO.Error.illegalOperationErrorType' if the file system does not -- support symbolic links. -- -- @since 1.5.0 createDirLink :: MonadIO m => Path b0 Dir -- ^ Path to the target directory -> Path b1 Dir -- ^ Path to the link to be created -> m () createDirLink target' dest' = do let target = toFilePath target' dest = F.dropTrailingPathSeparator (toFilePath dest') liftIO $ D.createDirectoryLink target dest -- | Remove an existing /directory/ symbolic link. -- -- On Windows, this is an alias for 'removeDir'. On POSIX systems, this is -- an alias for 'removeFile'. -- -- See also: 'removeFile', which can remove an existing /file/ symbolic link. -- -- @since 1.5.0 removeDirLink :: MonadIO m => Path b Dir -- ^ Path to the link to be removed -> m () removeDirLink = liftD D.removeDirectoryLink -- | Retrieve the target path of either a file or directory symbolic link. -- The returned path may not exist, and may not even be a valid path. -- -- On Windows systems, this calls @DeviceIoControl@ with -- @FSCTL_GET_REPARSE_POINT@. In addition to symbolic links, the function -- also works on junction points. On POSIX systems, this calls @readlink@. -- -- Windows-specific errors: This operation may fail with -- 'System.IO.Error.illegalOperationErrorType' if the file system does not -- support symbolic links. -- -- @since 1.5.0 getSymlinkTarget :: MonadIO m => Path b t -- ^ Symlink path -> m FilePath getSymlinkTarget = liftD (D.getSymbolicLinkTarget . F.dropTrailingPathSeparator) -- | Check whether the path refers to a symbolic link. An exception is thrown -- if the path does not exist or is inaccessible. -- -- On Windows, this checks for @FILE_ATTRIBUTE_REPARSE_POINT@. In addition to -- symbolic links, the function also returns true on junction points. On -- POSIX systems, this checks for @S_IFLNK@. -- -- @since 1.5.0 -- | Check if the given path is a symbolic link. -- -- @since 1.3.0 isSymlink :: MonadIO m => Path b t -> m Bool isSymlink = liftD (D.pathIsSymbolicLink . F.dropTrailingPathSeparator) ---------------------------------------------------------------------------- -- Temporary files and directories -- | Use a temporary file that doesn't already exist. -- -- Creates a new temporary file inside the given directory, making use of -- the template. The temporary file is deleted after use. -- -- @since 0.2.0 withTempFile :: (MonadIO m, MonadMask m) => Path b Dir -- ^ Directory to create the file in -> String -- ^ File name template, see 'openTempFile' -> (Path Abs File -> Handle -> m a) -- ^ Callback that can use the file -> m a withTempFile path t action = do apath <- makeAbsolute path T.withTempFile (toFilePath apath) t $ \file h -> parseAbsFile file >>= flip action h -- | Create and use a temporary directory. -- -- Creates a new temporary directory inside the given directory, making use -- of the template. The temporary directory is deleted after use. -- -- @since 0.2.0 withTempDir :: (MonadIO m, MonadMask m) => Path b Dir -- ^ Directory to create the file in -> String -- ^ Directory name template, see 'openTempFile' -> (Path Abs Dir -> m a) -- ^ Callback that can use the directory -> m a withTempDir path t action = do apath <- makeAbsolute path T.withTempDirectory (toFilePath apath) t (parseAbsDir >=> action) -- | Create and use a temporary file in the system standard temporary -- directory. -- -- Behaves exactly the same as 'withTempFile', except that the parent -- temporary directory will be that returned by 'getTempDir'. -- -- @since 0.2.0 withSystemTempFile :: (MonadIO m, MonadMask m) => String -- ^ File name template, see 'openTempFile' -> (Path Abs File -> Handle -> m a) -- ^ Callback that can use the file -> m a withSystemTempFile t action = getTempDir >>= \path -> withTempFile path t action -- | Create and use a temporary directory in the system standard temporary -- directory. -- -- Behaves exactly the same as 'withTempDir', except that the parent -- temporary directory will be that returned by 'getTempDir'. -- -- @since 0.2.0 withSystemTempDir :: (MonadIO m, MonadMask m) => String -- ^ Directory name template, see 'openTempFile' -> (Path Abs Dir -> m a) -- ^ Callback that can use the directory -> m a withSystemTempDir t action = getTempDir >>= \path -> withTempDir path t action -- | The function creates a temporary file in @rw@ mode. The created file -- isn't deleted automatically, so you need to delete it manually. -- -- The file is created with permissions such that only the current user can -- read\/write it. -- -- With some exceptions (see below), the file will be created securely in -- the sense that an attacker should not be able to cause openTempFile to -- overwrite another file on the filesystem using your credentials, by -- putting symbolic links (on Unix) in the place where the temporary file is -- to be created. On Unix the @O_CREAT@ and @O_EXCL@ flags are used to -- prevent this attack, but note that @O_EXCL@ is sometimes not supported on -- NFS filesystems, so if you rely on this behaviour it is best to use local -- filesystems only. -- -- @since 0.2.0 openTempFile :: MonadIO m => Path b Dir -- ^ Directory to create file in -> String -- ^ File name template; if the template is "foo.ext" then the created -- file will be @\"fooXXX.ext\"@ where @XXX@ is some random number -> m (Path Abs File, Handle) -- ^ Name of created file and its 'Handle' openTempFile path t = liftIO $ do apath <- makeAbsolute path (tfile, h) <- liftD2' T.openTempFile apath t (,h) <$> parseAbsFile tfile -- | Like 'openTempFile', but opens the file in binary mode. On Windows, -- reading a file in text mode (which is the default) will translate @CRLF@ -- to @LF@, and writing will translate @LF@ to @CRLF@. This is usually what -- you want with text files. With binary files this is undesirable; also, as -- usual under Microsoft operating systems, text mode treats control-Z as -- EOF. Binary mode turns off all special treatment of end-of-line and -- end-of-file characters. -- -- @since 0.2.0 openBinaryTempFile :: MonadIO m => Path b Dir -- ^ Directory to create file in -> String -- ^ File name template, see 'openTempFile' -> m (Path Abs File, Handle) -- ^ Name of created file and its 'Handle' openBinaryTempFile path t = liftIO $ do apath <- makeAbsolute path (tfile, h) <- liftD2' T.openBinaryTempFile apath t (,h) <$> parseAbsFile tfile -- | Create a temporary directory. The created directory isn't deleted -- automatically, so you need to delete it manually. -- -- The directory is created with permissions such that only the current user -- can read\/write it. -- -- @since 0.2.0 createTempDir :: MonadIO m => Path b Dir -- ^ Directory to create file in -> String -- ^ Directory name template, see 'openTempFile' -> m (Path Abs Dir) -- ^ Name of created temporary directory createTempDir path t = liftIO $ makeAbsolute path >>= \apath -> liftD2' T.createTempDirectory apath t >>= parseAbsDir ---------------------------------------------------------------------------- -- 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) -- | If argument of the function throws a -- 'System.IO.Error.doesNotExistErrorType', 'Nothing' is returned (other -- exceptions propagate). Otherwise the result is returned inside a 'Just'. -- -- @since 0.3.0 forgivingAbsence :: (MonadIO m, MonadCatch m) => m a -> m (Maybe a) forgivingAbsence f = catchIf isDoesNotExistError (Just <$> f) (const $ return Nothing) -- | The same as 'forgivingAbsence', but ignores result. -- -- @since 0.3.1 ignoringAbsence :: (MonadIO m, MonadCatch m) => m a -> m () ignoringAbsence = void . forgivingAbsence ---------------------------------------------------------------------------- -- 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 -- | 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. -- -- Note: this is a piece of conditional API, only available if -- @directory-1.2.3.0@ or later is used. 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. -- -- Note: this is a piece of conditional API, only available if -- @directory-1.2.3.0@ or later is used. 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. -- -- Note: this is a piece of conditional API, only available if -- @directory-1.2.3.0@ or later is used. setModificationTime :: MonadIO m => Path b t -> UTCTime -> m () setModificationTime = liftD2' D.setModificationTime -- | 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 {-# INLINE liftD #-} -- | 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) {-# INLINE liftD2 #-} -- | Similar to 'liftD2', but allows to pass second argument of arbitrary -- type. liftD2' :: MonadIO m => (FilePath -> v -> IO a) -- ^ Original action -> Path b t -- ^ First 'Path' argument -> v -- ^ Second argument -> m a liftD2' m a v = liftIO $ m (toFilePath a) v {-# INLINE liftD2' #-} -- | Perform an action ignoring IO exceptions it may throw. ignoringIOErrors :: IO () -> IO () ignoringIOErrors ioe = ioe `catch` handler where handler :: Monad m => IOError -> m () handler = const (return ()) path-io-1.6.0/README.md0000644000000000000000000000260107346545000012526 0ustar0000000000000000# 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) [![Stackage LTS](http://stackage.org/package/path-io/badge/lts)](http://stackage.org/lts/package/path-io) [![Build Status](https://travis-ci.org/mrkkrp/path-io.svg?branch=master)](https://travis-ci.org/mrkkrp/path-io) [![Build status](https://ci.appveyor.com/api/projects/status/q0orxo6856n18jvg/branch/master?svg=true)](https://ci.appveyor.com/project/mrkkrp/path-io/branch/master) This package provides an interface to the [`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, working with temporary files/directories, etc. Consult Haddocks for usage, which should be trivial. ## Contribution Issues, bugs, and questions may be reported in [the GitHub issue tracker for this project](https://github.com/mrkkrp/path-io/issues). Pull requests are also welcome. ## License Copyright © 2016–present Mark Karpov Distributed under BSD 3 clause license. path-io-1.6.0/Setup.hs0000644000000000000000000000012707346545000012704 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain path-io-1.6.0/path-io.cabal0000644000000000000000000000503107346545000013574 0ustar0000000000000000name: path-io version: 1.6.0 cabal-version: 1.18 tested-with: GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 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-doc-files: CHANGELOG.md , README.md flag dev description: Turn on development settings. manual: True default: False library build-depends: base >= 4.11 && < 5.0 , containers , directory >= 1.3.2.0 && < 1.4 , dlist >= 0.8 && < 0.9 , exceptions >= 0.8 && < 0.11 , filepath >= 1.2 && < 1.5 , path >= 0.6 && < 0.7 , temporary >= 1.1 && < 1.4 , time >= 1.4 && < 1.10 , transformers >= 0.3 && < 0.6 , unix-compat exposed-modules: Path.IO if flag(dev) ghc-options: -Wall -Werror else ghc-options: -O2 -Wall if flag(dev) ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances default-language: Haskell2010 test-suite tests main-is: Main.hs hs-source-dirs: tests type: exitcode-stdio-1.0 if flag(dev) ghc-options: -Wall -Werror else ghc-options: -O2 -Wall build-depends: base >= 4.11 && < 5.0 , directory >= 1.3.2.0 && < 1.4 , exceptions >= 0.8 && < 0.11 , hspec >= 2.0 && < 3.0 , filepath >= 1.2 && < 1.5 , path >= 0.6 && < 0.7 , path-io , transformers >= 0.3 && < 0.6 , unix-compat default-language: Haskell2010 source-repository head type: git location: https://github.com/mrkkrp/path-io.git path-io-1.6.0/tests/0000755000000000000000000000000007346545000012412 5ustar0000000000000000path-io-1.6.0/tests/Main.hs0000644000000000000000000003167407346545000013645 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Main (main) where import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO (..)) import Data.Bifunctor import Data.List (sort) import Path import Path.IO import System.Environment import System.PosixCompat.Files import Test.Hspec main :: IO () main = hspec . around withSandbox $ do #ifndef mingw32_HOST_OS beforeWith populatedDir $ do -- NOTE These tests shall fail on Windows as unix-compat does not -- implement createSymbolicLink for windows. describe "listDir" listDirSpec describe "listDirRel" listDirRelSpec describe "listDirRecur" listDirRecurSpec describe "listDirRecurRel" listDirRecurRelSpec describe "listDirRecurWith" listDirRecurWithSpec describe "walkDir Finish" walkDirFinishSpec describe "copyDirRecur" copyDirRecurSpec describe "copyDirRecur'" copyDirRecur'Spec describe "findFile" findFileSpec beforeWith populatedCyclicDir $ describe "listDirRecur Cyclic" listDirRecurCyclicSpec #endif describe "getCurrentDir" getCurrentDirSpec describe "setCurrentDir" setCurrentDirSpec describe "withCurrentDir" withCurrentDirSpec describe "walkDirRel" walkDirRelSpec #ifndef mingw32_HOST_OS -- NOTE We can't quite test this on Windows as well, because the -- environmental variables HOME and TMPDIR do not exist there. describe "getHomeDir" getHomeDirSpec describe "getTempDir" getTempDirSpec describe "getXdgDir Data" getXdgDataDirSpec describe "getXdgDir Config" getXdgConfigDirSpec describe "getXdgDir Cache" getXdgCacheDirSpec #endif listDirSpec :: SpecWith (Path Abs Dir) listDirSpec = it "lists directory" $ \dir -> getDirStructure listDir dir `shouldReturn` populatedDirTop listDirRelSpec :: SpecWith (Path Abs Dir) listDirRelSpec = it "lists directory" $ \dir -> getDirStructureRel listDirRel dir `shouldReturn` populatedDirTop listDirRecurSpec :: SpecWith (Path Abs Dir) listDirRecurSpec = it "lists directory recursively" $ \dir -> getDirStructure listDirRecur dir `shouldReturn` populatedDirStructure listDirRecurRelSpec :: SpecWith (Path Abs Dir) listDirRecurRelSpec = it "lists directory recursively" $ \dir -> getDirStructureRel listDirRecurRel dir `shouldReturn` populatedDirStructure listDirRecurWithSpec :: SpecWith (Path Abs Dir) listDirRecurWithSpec = it "lists directory recursively using predicates" $ \dir -> getDirStructure (listDirRecurWith (return . ($(mkRelDir "c") /=) . dirname) (return . ($(mkRelFile "two.txt") /=) . filename)) dir `shouldReturn` populatedDirRecurWith listDirRecurWith :: (Path Abs Dir -> IO Bool) -- ^ Dir match predicate -> (Path Abs File -> IO Bool) -- ^ File match predicate -> Path Abs Dir -- ^ Top dir to traverse -> IO ([Path Abs Dir], [Path Abs File]) -- ^ Matched subdirs and files listDirRecurWith dirPred filePred = walkDirAccum Nothing $ \_ d f -> do d' <- filterM dirPred d f' <- filterM filePred f return (d', f') -- | walkDir with a Finish handler may have unpredictable output depending on -- the order of traversal. The only guarantee is that we will finish only after -- we find the directory "c". Though if we test only for the presence of "c" we -- are not really testing if we indeed cut the traversal short. walkDirFinishSpec :: SpecWith (Path Abs Dir) walkDirFinishSpec = it "Finishes only after finding what it is looking for" $ \dir -> do (d, _) <- getDirStructure (walkDirAccum (Just dHandler) writer) dir map dirname d `shouldContain` [$(mkRelDir "c")] where dHandler p _ _ | dirname p == $(mkRelDir "c") = return WalkFinish | otherwise = return (WalkExclude []) writer _ d f = return (d, f) copyDirRecurSpec :: SpecWith (Path Abs Dir) copyDirRecurSpec = do context "when source directory is editable" $ it "copies directory" $ \src -> do let dest = parent src $(mkRelDir "copied-dir") copyDirRecur src dest old <- getDirStructure listDirRecur src new <- getDirStructure listDirRecur dest old `shouldBe` new context "when source directory is read-only" $ it "copies directory just as well (preserving permissions)" $ \src -> do let dest = parent src $(mkRelDir "copied-dir") srcPermissions <- setOwnerWritable False <$> getPermissions src setPermissions src srcPermissions copyDirRecur src dest old <- getDirStructure listDirRecur src new <- getDirStructure listDirRecur dest old `shouldBe` new getPermissions dest `shouldReturn` srcPermissions copyDirRecur'Spec :: SpecWith (Path Abs Dir) copyDirRecur'Spec = context "when source directory is read-only" $ it "copies directory but now it's editable" $ \src -> do let dest = parent src $(mkRelDir "copied-dir") srcPermissions <- setOwnerWritable False <$> getPermissions src setPermissions src srcPermissions copyDirRecur' src dest old <- getDirStructure listDirRecur src new <- getDirStructure listDirRecur dest old `shouldBe` new getPermissions dest `shouldReturn` srcPermissions { writable = True } findFileSpec :: SpecWith (Path Abs Dir) findFileSpec = it "finds a file lazily" $ \dir -> do let relFile = head (snd populatedDirTop) found <- findFile (dir : undefined) relFile found `shouldBe` Just (dir relFile) listDirRecurCyclicSpec :: SpecWith (Path Abs Dir) listDirRecurCyclicSpec = it "lists directory trees having traversal cycles" $ \dir -> getDirStructure listDirRecurCyclic dir `shouldReturn` populatedCyclicDirStructure -- Follows symbolic links listDirRecurCyclic :: (MonadIO m, MonadThrow m) => Path b Dir -- ^ Directory to list -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files listDirRecurCyclic = walkDirAccum Nothing (\_ d f -> return (d, f)) getCurrentDirSpec :: SpecWith (Path Abs Dir) getCurrentDirSpec = it "returns current dir" $ \dir -> getCurrentDir `shouldNotReturn` dir setCurrentDirSpec :: SpecWith (Path Abs Dir) setCurrentDirSpec = it "sets current dir" $ \dir -> do wdir <- getCurrentDir setCurrentDir dir new <- getCurrentDir setCurrentDir wdir new `shouldBe` dir withCurrentDirSpec :: SpecWith (Path Abs Dir) withCurrentDirSpec = it "temporarily modifies current dir" $ \dir -> do withCurrentDir dir $ getCurrentDir `shouldReturn` dir getCurrentDir `shouldNotReturn` dir walkDirRelSpec :: SpecWith (Path Abs Dir) walkDirRelSpec = it "does not throw exceptions" $ \dir -> do let handler curdir subdirs files = do curdir `shouldBe` $(mkRelDir ".") subdirs `shouldBe` [] files `shouldBe` [] return WalkFinish walkDirRel handler dir getHomeDirSpec :: SpecWith (Path Abs Dir) getHomeDirSpec = it "home dir is influenced by environment variable HOME" $ \dir -> bracket (getEnv evar) (setEnv evar) $ \_ -> do setEnv evar (toFilePath dir) getHomeDir `shouldReturn` dir where evar = "HOME" getTempDirSpec :: SpecWith (Path Abs Dir) getTempDirSpec = it "temp dir is influenced by environment variable TMPDIR" $ \dir -> flip finally (unsetEnv evar) $ do setEnv evar (toFilePath dir) getTempDir `shouldReturn` dir unsetEnv evar where evar = "TMPDIR" getXdgDataDirSpec :: SpecWith (Path Abs Dir) getXdgDataDirSpec = it "XDG data dir is influenced by environment variable XDG_DATA_HOME" $ \dir -> flip finally (unsetEnv evar) $ do setEnv evar (toFilePath dir) getXdgDir XdgData (Just name) `shouldReturn` (dir name) getXdgDir XdgData Nothing `shouldReturn` dir unsetEnv evar where evar = "XDG_DATA_HOME" name = $(mkRelDir "test") getXdgConfigDirSpec :: SpecWith (Path Abs Dir) getXdgConfigDirSpec = it "XDG config dir is influenced by environment variable XDG_CONFIG_HOME" $ \dir -> flip finally (unsetEnv evar) $ do setEnv evar (toFilePath dir) getXdgDir XdgConfig (Just name) `shouldReturn` (dir name) getXdgDir XdgConfig Nothing `shouldReturn` dir unsetEnv evar where evar = "XDG_CONFIG_HOME" name = $(mkRelDir "test") getXdgCacheDirSpec :: SpecWith (Path Abs Dir) getXdgCacheDirSpec = it "XDG cache dir is influenced by environment variable XDG_CACHE_HOME" $ \dir -> flip finally (unsetEnv evar) $ do setEnv evar (toFilePath dir) getXdgDir XdgCache (Just name) `shouldReturn` (dir name) getXdgDir XdgCache Nothing `shouldReturn` dir unsetEnv evar where evar = "XDG_CACHE_HOME" name = $(mkRelDir "test") ---------------------------------------------------------------------------- -- Helpers -- | Create a sandbox directory to model some situation in it and run some -- tests. Note that we're using new unique sandbox directory for each test -- case to avoid contamination and it's unconditionally deleted after test -- case finishes. withSandbox :: ActionWith (Path Abs Dir) -> IO () withSandbox = withSystemTempDir "path-io-sandbox" -- | Create directory and some sub-directories and files in it. Return path -- to that directory. -- -- Created objects are described in 'populatedDirStructure'. populatedDir :: Path Abs Dir -> IO (Path Abs Dir) populatedDir root = do let (_, files) = populatedDirStructure pdir = root $(mkRelDir "pdir") withinSandbox = (pdir ) ensureDir pdir ensureDir $ withinSandbox $(mkRelDir "b") ensureDir $ withinSandbox $(mkRelDir "b/c") -- to verify that we do not follow symbolic links. We should not list b's -- tree under 'a'. createSymbolicLink "b" (toFilePath $ withinSandbox $(mkRelFile "a")) forM_ files $ (`writeFile` "") . toFilePath . withinSandbox return pdir -- | Get inner structure of a directory. Items are sorted, so it's easier to -- compare results. getDirStructure :: (Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])) -- ^ Which function to use for scanning -> Path Abs Dir -- ^ Path to directory to scan -> IO ([Path Rel Dir], [Path Rel File]) getDirStructure f path = do (dirs, files) <- f path rdirs <- sort <$> mapM (makeRelative path) dirs rfiles <- sort <$> mapM (makeRelative path) files return (rdirs, rfiles) -- | A version of 'getDirStructure' that accepts scanning function that -- returns relative paths. getDirStructureRel :: (Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])) -- ^ Which function to use for scanning -> Path Abs Dir -- ^ Path to directory to scan -> IO ([Path Rel Dir], [Path Rel File]) getDirStructureRel f path = bimap sort sort <$> f path -- | Structure of directory created by the 'populatedDir' function. Please -- keep it sorted. populatedDirStructure :: ([Path Rel Dir], [Path Rel File]) populatedDirStructure = ( [ $(mkRelDir "a") , $(mkRelDir "b") , $(mkRelDir "b/c") ] , [ $(mkRelFile "b/c/three.txt") , $(mkRelFile "b/two.txt") , $(mkRelFile "one.txt") ] ) -- | Create a directory structure which has cycles in it due to directory -- symbolic links. -- -- 1) Mutual cycles between two directory trees. If we traverse @a@ or @c@ we -- will get into the same cycle: -- a\/(b -> c), c\/(d -> a) -- c\/(d -> a), a\/(b -> c) -- 2) Cycle with own ancestor -- e\/f\/(g -> e) populatedCyclicDirStructure :: ([Path Rel Dir], [Path Rel File]) populatedCyclicDirStructure = ( [ $(mkRelDir "a") , $(mkRelDir "a/b") -- b points to c , $(mkRelDir "a/b/d") -- because b is same as c , $(mkRelDir "c") , $(mkRelDir "c/d") -- d points to a , $(mkRelDir "c/d/b") -- because d is same as a , $(mkRelDir "e") , $(mkRelDir "e/f") , $(mkRelDir "e/f/g") -- g points to e ] , [] ) -- | Created the objects described in 'populatedCyclicDirStructure'. -- Return path to that directory. populatedCyclicDir :: Path Abs Dir -> IO (Path Abs Dir) populatedCyclicDir root = do let pdir = root $(mkRelDir "pdir") withinSandbox = (pdir ) ensureDir pdir ensureDir $ withinSandbox $(mkRelDir "a") ensureDir $ withinSandbox $(mkRelDir "c") ensureDir $ withinSandbox $(mkRelDir "e/f") createSymbolicLink "../c" (toFilePath $ withinSandbox $(mkRelFile "a/b")) createSymbolicLink "../a" (toFilePath $ withinSandbox $(mkRelFile "c/d")) createSymbolicLink "../../e" (toFilePath $ withinSandbox $(mkRelFile "e/f/g")) return pdir -- | Top-level structure of populated directory as it should be scanned by -- the 'listDir' function. populatedDirTop :: ([Path Rel Dir], [Path Rel File]) populatedDirTop = ( [ $(mkRelDir "a") , $(mkRelDir "b") ] , [ $(mkRelFile "one.txt") ] ) -- | Structure of populated directory as it should be scanned by -- 'listDirRecurWith' function using predicates to filter out dir 'c' and the -- file 'two.txt' populatedDirRecurWith :: ([Path Rel Dir], [Path Rel File]) populatedDirRecurWith = ( [ $(mkRelDir "a") , $(mkRelDir "b") ] , [ $(mkRelFile "a/c/three.txt") -- via symbolic link , $(mkRelFile "b/c/three.txt") , $(mkRelFile "one.txt") ] )