Hello community, here is the log from the commit of package ghc-path-io for openSUSE:Factory checked in at 2018-05-30 12:11:29 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-path-io (Old) and /work/SRC/openSUSE:Factory/.ghc-path-io.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-path-io" Wed May 30 12:11:29 2018 rev:7 rq:607853 version:1.3.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-path-io/ghc-path-io.changes 2017-09-15 22:03:30.586460993 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-path-io.new/ghc-path-io.changes 2018-05-30 12:26:41.519547431 +0200 @@ -1,0 +2,17 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update path-io to version 1.3.3 revision 3. + * (Hopefully) fixed test suite failure with Cabal 2.0 and GHC 8.2.1. + * Reduce a number of `(MonadIO m, MonadThrow m)` constraints to just + `MonadIO m` [#27](https://github.com/mrkkrp/path-io/issues/27) + * Made `listDirRecur` faster for deep directory trees. + * 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. + +------------------------------------------------------------------- Old: ---- path-io-1.2.2.tar.gz New: ---- path-io-1.3.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-path-io.spec ++++++ --- /var/tmp/diff_new_pack.fpW20D/_old 2018-05-30 12:26:42.703507003 +0200 +++ /var/tmp/diff_new_pack.fpW20D/_new 2018-05-30 12:26:42.707506866 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-path-io # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,17 +19,18 @@ %global pkg_name path-io %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.2.2 +Version: 1.3.3 Release: 0 Summary: Interface to ‘directory’ package for users of ‘path’ License: BSD-3-Clause Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/3.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-containers-devel BuildRequires: ghc-directory-devel +BuildRequires: ghc-dlist-devel BuildRequires: ghc-exceptions-devel BuildRequires: ghc-filepath-devel BuildRequires: ghc-path-devel @@ -76,7 +77,7 @@ %ghc_pkg_recache %files -f %{name}.files -%doc LICENSE.md +%license LICENSE.md %files devel -f %{name}-devel.files %doc CHANGELOG.md README.md ++++++ path-io-1.2.2.tar.gz -> path-io-1.3.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-io-1.2.2/CHANGELOG.md new/path-io-1.3.3/CHANGELOG.md --- old/path-io-1.2.2/CHANGELOG.md 2017-01-06 17:25:46.000000000 +0100 +++ new/path-io-1.3.3/CHANGELOG.md 2017-07-31 07:19:49.000000000 +0200 @@ -1,3 +1,34 @@ +## 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-io-1.2.2/Path/IO.hs new/path-io-1.3.3/Path/IO.hs --- old/path-io-1.2.2/Path/IO.hs 2017-01-06 17:24:50.000000000 +0100 +++ new/path-io-1.3.3/Path/IO.hs 2017-07-12 16:01:50.000000000 +0200 @@ -3,13 +3,14 @@ -- Copyright : © 2016–2017 Mark Karpov -- License : BSD 3 clause -- --- Maintainer : Mark Karpov <[email protected]> +-- Maintainer : Mark Karpov <[email protected]> -- 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. +-- 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 CPP #-} {-# LANGUAGE FlexibleInstances #-} @@ -46,8 +47,6 @@ , getXdgDir #endif -- * Path transformation - , AbsPath - , RelPath , AnyPath (..) , resolveFile , resolveFile' @@ -61,6 +60,8 @@ , findFile , findFiles , findFilesWith + -- * Symbolic links + , isSymlink -- * Temporary files and directories , withTempFile , withTempDir @@ -98,6 +99,7 @@ , getModificationTime ) where +import Control.Arrow ((***)) import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO (..)) @@ -110,15 +112,16 @@ import Path import System.IO (Handle) import System.IO.Error (isDoesNotExistError) -import System.PosixCompat.Files (deviceID, fileID, getFileStatus) +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 + #if MIN_VERSION_directory(1,2,3) import System.Directory (XdgDirectory) #endif -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 - #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid) #endif @@ -151,10 +154,9 @@ -- 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]@ +-- * '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. @@ -162,10 +164,9 @@ createDir :: MonadIO m => Path b Dir -> m () createDir = liftD D.createDirectory -{-# INLINE createDir #-} -- | @'createDirIfMissing' parents dir@ creates a new directory @dir@ if it --- doesn\'t exist. If the first argument is 'True' the function will also +-- doesn't exist. If the first argument is 'True' the function will also -- create all parent directories if they are missing. createDirIfMissing :: MonadIO m @@ -173,10 +174,9 @@ -> Path b Dir -- ^ The path to the directory you want to make -> m () createDirIfMissing p = liftD (D.createDirectoryIfMissing p) -{-# INLINE createDirIfMissing #-} --- | Ensure that directory exists creating it and its parent directories if --- necessary. This is just a handy shortcut: +-- | Ensure that a directory exists creating it and its parent directories +-- if necessary. This is just a handy shortcut: -- -- > ensureDir = createDirIfMissing True -- @@ -184,12 +184,11 @@ ensureDir :: MonadIO m => Path b Dir -> m () ensureDir = createDirIfMissing True -{-# INLINE ensureDir #-} -- | @'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 +-- 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). @@ -226,15 +225,13 @@ removeDir :: MonadIO m => Path b Dir -> m () removeDir = liftD D.removeDirectory -{-# INLINE removeDir #-} -- | @'removeDirRecur' dir@ removes an existing directory @dir@ together --- with its contents and subdirectories. Within this directory, symbolic +-- 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 -{-# INLINE removeDirRecur #-} -- |@'renameDir' old new@ changes the name of an existing directory from -- @old@ to @new@. If the @new@ directory already exists, it is atomically @@ -287,7 +284,6 @@ -> Path b1 Dir -- ^ New name -> m () renameDir = liftD2 D.renameDirectory -{-# INLINE renameDir #-} -- | @'listDir' dir@ returns a list of /all/ entries in @dir@ without the -- special entries (@.@ and @..@). Entries are not sorted. @@ -318,10 +314,10 @@ -- The path refers to an existing non-directory object. -- @[ENOTDIR]@ -listDir :: (MonadIO m, MonadThrow m) +listDir :: MonadIO m => Path b Dir -- ^ Directory to list -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files -listDir path = do +listDir path = liftIO $ do bpath <- makeAbsolute path raw <- liftD D.getDirectoryContents bpath items <- forM (raw \\ [".", ".."]) $ \item -> do @@ -332,60 +328,76 @@ 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'. +-- | 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, MonadThrow m) - => Path b Dir -- ^ Directory to list +listDirRecur :: MonadIO m + => Path b Dir -- ^ Directory to list -> m ([Path Abs Dir], [Path Abs File]) -- ^ Sub-directories and files -listDirRecur = walkDirAccum Nothing (\_ d f -> return (d, f)) -{-# INLINE listDirRecur #-} - --- | 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. +listDirRecur dir = (DList.toList *** DList.toList) + `liftM` walkDirAccum (Just excludeSymlinks) writer dir + where + excludeSymlinks _ subdirs _ = + WalkExclude `liftM` filterM isSymlink subdirs + writer _ ds fs = return (DList.fromList ds, DList.fromList 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. copyDirRecur :: (MonadIO m, MonadCatch m) => Path b0 Dir -- ^ Source -> Path b1 Dir -- ^ Destination -> m () copyDirRecur = copyDirRecurGen True -{-# INLINE copyDirRecur #-} --- | The same as 'copyDirRecur', but it does not preserve directory --- permissions. This may be useful, for example, if directory you want to --- copy is “read-only”, but you want your copy to be editable. +-- | 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. copyDirRecur' :: (MonadIO m, MonadCatch m) => Path b0 Dir -- ^ Source -> Path b1 Dir -- ^ Destination -> m () copyDirRecur' = copyDirRecurGen False -{-# INLINE copyDirRecur' #-} -- | Generic version of 'copyDirRecur'. The first argument controls whether --- to preserve directory permissions or not. +-- to preserve directory permissions or not. /Does not/ follow symbolic +-- links. +-- +-- __Note__: before version /1.3.0/, this function followed symlinks. -copyDirRecurGen :: (MonadIO m, MonadCatch m) +copyDirRecurGen :: MonadIO m => Bool -- ^ Should we preserve directory permissions? -> Path b0 Dir -- ^ Source -> Path b1 Dir -- ^ Destination -> m () -copyDirRecurGen p src dest = do +copyDirRecurGen p src dest = liftIO $ do bsrc <- makeAbsolute src bdest <- makeAbsolute dest (dirs, files) <- listDirRecur bsrc - let swapParent :: MonadThrow m - => Path Abs Dir + let swapParent + :: Path Abs Dir -> Path Abs Dir -> Path Abs t - -> m (Path Abs t) - swapParent old new path = (new </>) `liftM` stripDir old path + -> IO (Path Abs t) + swapParent old new path = (new </>) `liftM` +#if MIN_VERSION_path(0,6,0) + stripProperPrefix old path +#else + stripDir old path +#endif tdirs <- mapM (swapParent bsrc bdest) dirs tfiles <- mapM (swapParent bsrc bdest) files ensureDir bdest @@ -405,30 +417,31 @@ -- -- 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. +-- 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. +-- 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 decides how --- the traversal will proceed further. +-- | Action returned by the traversal handler function. The action controls +-- how the traversal will proceed. -- -- @since 1.2.0 @@ -436,18 +449,21 @@ = WalkFinish -- ^ Finish the entire walk altogether | WalkExclude [Path Abs 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. --- --- Detects and silently avoids any traversal loops in the directory tree. +-- | 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, MonadThrow m) + :: MonadIO m => (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m WalkAction) -- ^ Handler (@dir -> subdirs -> files -> 'WalkAction'@) -> Path b Dir @@ -475,26 +491,26 @@ ds -> runMaybeT $ mapM_ (MaybeT . walkAvoidLoop traversed) ds checkLoop traversed dir = do - st <- liftIO $ getFileStatus (toFilePath dir) - let ufid = (deviceID st, fileID st) + st <- liftIO $ P.getFileStatus (toFilePath dir) + let ufid = (P.deviceID st, P.fileID st) -- check for loop, have we already traversed this dir? return $ if S.member ufid traversed then Nothing else Just (S.insert ufid traversed) --- | 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. +-- | 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, MonadThrow m, Monoid o) + :: (MonadIO m, Monoid o) => Maybe (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m WalkAction) -- ^ Descend handler (@dir -> subdirs -> files -> 'WalkAction'@), -- descend the whole tree if omitted @@ -504,7 +520,7 @@ -- ^ Directory where traversal begins -> m o -- ^ Accumulation of outputs generated by the output writer invocations -walkDirAccum dHandler writer topdir = execWriterT $ walkDir handler topdir +walkDirAccum dHandler writer topdir = execWriterT (walkDir handler topdir) where handler dir subdirs files = do res <- lift $ writer dir subdirs files @@ -543,9 +559,8 @@ -- * '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 -{-# INLINE getCurrentDir #-} +getCurrentDir :: MonadIO m => m (Path Abs Dir) +getCurrentDir = liftIO $ D.getCurrentDirectory >>= parseAbsDir -- | Change the working directory to the given path. -- @@ -582,7 +597,6 @@ setCurrentDir :: MonadIO m => Path b Dir -> m () setCurrentDir = liftD D.setCurrentDirectory -{-# INLINE setCurrentDir #-} -- | Run an 'IO' action with the given working directory and restore the -- original working directory afterwards, even if the given action fails due @@ -601,7 +615,7 @@ ---------------------------------------------------------------------------- -- Pre-defined directories --- | Returns the current user's home directory. +-- | 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 @@ -620,9 +634,8 @@ -- The home directory for the current user does not exist, or -- cannot be found. -getHomeDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) +getHomeDir :: MonadIO m => m (Path Abs Dir) getHomeDir = liftIO D.getHomeDirectory >>= resolveDir' -{-# INLINE getHomeDir #-} -- | Obtain the path to a special directory for storing user-specific -- application data (traditional Unix location). @@ -648,13 +661,12 @@ -- The home directory for the current user does not exist, or cannot be -- found. -getAppUserDataDir :: (MonadIO m, MonadThrow m) +getAppUserDataDir :: MonadIO m => String -- ^ Name of application (used in path construction) -> m (Path Abs Dir) -getAppUserDataDir = (>>= parseAbsDir) . liftIO . D.getAppUserDataDirectory -{-# INLINE getAppUserDataDir #-} +getAppUserDataDir = liftIO . (>>= parseAbsDir) . D.getAppUserDataDirectory --- | Returns the current user's document directory. +-- | 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 @@ -673,11 +685,10 @@ -- 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 -{-# INLINE getUserDocsDir #-} +getUserDocsDir :: MonadIO m => m (Path Abs Dir) +getUserDocsDir = liftIO $ D.getUserDocumentsDirectory >>= parseAbsDir --- | Returns the current directory for temporary files. +-- | 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 @@ -703,9 +714,8 @@ -- -- The function doesn't verify whether the path exists. -getTempDir :: (MonadIO m, MonadThrow m) => m (Path Abs Dir) +getTempDir :: MonadIO m => m (Path Abs Dir) getTempDir = liftIO D.getTemporaryDirectory >>= resolveDir' -{-# INLINE getTempDir #-} #if MIN_VERSION_directory(1,2,3) -- | Obtain the paths to special directories for storing user-specific @@ -725,38 +735,31 @@ -- -- @since 1.2.1 -getXdgDir :: (MonadIO m, MonadThrow m) +getXdgDir :: MonadIO m => 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 -{-# INLINE getXdgDir #-} +getXdgDir xdgDir suffix = + liftIO $ (D.getXdgDirectory xdgDir $ maybe "" toFilePath suffix) >>= parseAbsDir #endif ---------------------------------------------------------------------------- -- Path transformation --- | Closed type family describing how to get absolute version of given --- 'Path'. +-- | Class of things ('Path's) that can be canonicalized, made absolute, and +-- made relative to a some base directory. -type family AbsPath path where - AbsPath (Path b File) = Path Abs File - AbsPath (Path b Dir) = Path Abs Dir +class AnyPath path where --- | Closed type family describing how to get relative version of given --- 'Path'. --- --- @since 0.3.0 + -- | Type of absolute version of the given @path@. -type family RelPath path where - RelPath (Path b File) = Path Rel File - RelPath (Path b Dir) = Path Rel Dir + type AbsPath path :: * --- | Class of things ('Path's) that can be canonicalized and made absolute. + -- | Type of relative version of the given @path@. -class AnyPath path where + type RelPath path :: * -- | Make a path absolute and remove as many indirections from it as -- possible. Indirections include the two special directories @.@ and @@ -767,43 +770,41 @@ -- 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, + -- 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 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. + -- 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.) -- - -- Similar to 'normalise', an empty path is equivalent to the current - -- directory. - -- -- /Known bug(s)/: on Windows, the function does not resolve symbolic -- links. -- - -- Please note that before version 1.2.3.0 of @directory@ package, this - -- function had unpredictable behavior on non-existent paths. + -- 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, MonadThrow m) - => path -> m (AbsPath path) + canonicalizePath :: MonadIO 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. + -- 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 - -- 'getCurrentDirectory'. + -- the operation may fail with the same exceptions as 'getCurrentDir'. - makeAbsolute :: (MonadIO m, MonadThrow m) - => path -> m (AbsPath path) + makeAbsolute :: MonadIO m + => path + -> m (AbsPath path) - -- | Make a path relative to given directory. + -- | Make a path relative to a given directory. -- -- @since 0.3.0 @@ -816,73 +817,68 @@ -- -- @since 0.3.0 - makeRelativeToCurrentDir :: (MonadIO m, MonadThrow m) - => path -> m (RelPath path) + makeRelativeToCurrentDir :: MonadIO m + => path + -> m (RelPath path) instance AnyPath (Path b File) where - canonicalizePath = liftD D.canonicalizePath >=> parseAbsFile - {-# INLINE canonicalizePath #-} - makeAbsolute = liftD D.makeAbsolute >=> parseAbsFile - {-# INLINE makeAbsolute #-} + + 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)) - {-# INLINE makeRelative #-} - makeRelativeToCurrentDir p = getCurrentDir >>= flip makeRelative p - {-# INLINE makeRelativeToCurrentDir #-} + makeRelativeToCurrentDir p = liftIO $ getCurrentDir >>= flip makeRelative p instance AnyPath (Path b Dir) where - canonicalizePath = liftD D.canonicalizePath >=> parseAbsDir - {-# INLINE canonicalizePath #-} - makeAbsolute = liftD D.makeAbsolute >=> parseAbsDir - {-# INLINE makeAbsolute #-} + + 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)) - {-# INLINE makeRelative #-} - makeRelativeToCurrentDir p = getCurrentDir >>= flip makeRelative p - {-# INLINE makeRelativeToCurrentDir #-} + 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, MonadThrow m) +resolveFile :: MonadIO m => Path Abs Dir -- ^ Base directory -> FilePath -- ^ Path to resolve -> m (Path Abs File) -resolveFile b p = f (toFilePath b F.</> p) >>= parseAbsFile - where f = liftIO . D.canonicalizePath -{-# INLINE resolveFile #-} +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, MonadThrow m) +resolveFile' :: MonadIO m => FilePath -- ^ Path to resolve -> m (Path Abs File) resolveFile' p = getCurrentDir >>= flip resolveFile p -{-# INLINE resolveFile' #-} -- | The same as 'resolveFile', but for directories. -- -- @since 0.3.0 -resolveDir :: (MonadIO m, MonadThrow m) +resolveDir :: MonadIO m => Path Abs Dir -- ^ Base directory -> FilePath -- ^ Path to resolve -> m (Path Abs Dir) -resolveDir b p = f (toFilePath b F.</> p) >>= parseAbsDir - where f = liftIO . D.canonicalizePath -{-# INLINE resolveDir #-} +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, MonadThrow m) +resolveDir' :: MonadIO m => FilePath -- ^ Path to resolve -> m (Path Abs Dir) resolveDir' p = getCurrentDir >>= flip resolveDir p -{-# INLINE resolveDir' #-} ---------------------------------------------------------------------------- -- Actions on files @@ -920,7 +916,6 @@ removeFile :: MonadIO m => Path b File -> m () removeFile = liftD D.removeFile -{-# INLINE 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 @@ -968,7 +963,6 @@ -> Path b1 File -- ^ New location -> m () renameFile = liftD2 D.renameFile -{-# INLINE 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@ @@ -980,16 +974,15 @@ -> Path b1 File -- ^ Where to put copy -> m () copyFile = liftD2 D.copyFile -{-# INLINE 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). +-- 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 @@ -1001,11 +994,10 @@ => Path Rel File -- ^ Executable file name -> m (Maybe (Path Abs File)) -- ^ Path to found executable findExecutable = liftM (>>= parseAbsFile) . liftD D.findExecutable -{-# INLINE findExecutable #-} -- | Search through the given set of directories for the given file. -findFile :: (MonadIO m, MonadThrow m) +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) @@ -1020,18 +1012,17 @@ -- | 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) +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)) -{-# INLINE findFiles #-} -- | 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) +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 @@ -1046,6 +1037,20 @@ else findFilesWith f ds file ---------------------------------------------------------------------------- +-- Symbolic links + +-- | Check if the given path is a symbolic link. +-- +-- @since 1.3.0 + +isSymlink :: MonadIO m => Path b t -> m Bool +isSymlink p = liftIO $ liftM P.isSymbolicLink (P.getSymbolicLinkStatus path) + where + -- NOTE: To be able to correctly check whether it is a symlink or not we + -- have to drop the trailing separator from the dir path. + path = F.dropTrailingPathSeparator (toFilePath p) + +---------------------------------------------------------------------------- -- Temporary files and directories -- | Use a temporary file that doesn't already exist. @@ -1128,13 +1133,13 @@ -- -- @since 0.2.0 -openTempFile :: (MonadIO m, MonadThrow m) +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 = do +openTempFile path t = liftIO $ do apath <- makeAbsolute path (tfile, h) <- liftD2' T.openTempFile apath t (,h) `liftM` parseAbsFile tfile @@ -1149,16 +1154,16 @@ -- -- @since 0.2.0 -openBinaryTempFile :: (MonadIO m, MonadThrow m) +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 = do +openBinaryTempFile path t = liftIO $ do apath <- makeAbsolute path (tfile, h) <- liftD2' T.openBinaryTempFile apath t (,h) `liftM` parseAbsFile tfile --- | Create temporary directory. The created directory isn't deleted +-- | 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 @@ -1166,11 +1171,11 @@ -- -- @since 0.2.0 -createTempDir :: (MonadIO m, MonadThrow m) +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 = makeAbsolute path >>= \apath -> +createTempDir path t = liftIO $ makeAbsolute path >>= \apath -> liftD2' T.createTempDirectory apath t >>= parseAbsDir ---------------------------------------------------------------------------- @@ -1181,7 +1186,6 @@ doesFileExist :: MonadIO m => Path b File -> m Bool doesFileExist = liftD D.doesFileExist -{-# INLINE 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' @@ -1189,7 +1193,6 @@ doesDirExist :: MonadIO m => Path b Dir -> m Bool doesDirExist = liftD D.doesDirectoryExist -{-# INLINE doesDirExist #-} -- | Check if there is a file or directory on specified path. @@ -1210,7 +1213,6 @@ forgivingAbsence f = catchIf isDoesNotExistError (Just `liftM` f) (const $ return Nothing) -{-# INLINE forgivingAbsence #-} -- | The same as 'forgivingAbsence', but ignores result. -- @@ -1218,7 +1220,6 @@ ignoringAbsence :: (MonadIO m, MonadCatch m) => m a -> m () ignoringAbsence = liftM (const ()) . forgivingAbsence -{-# INLINE ignoringAbsence #-} ---------------------------------------------------------------------------- -- Permissions @@ -1235,7 +1236,6 @@ getPermissions :: MonadIO m => Path b t -> m D.Permissions getPermissions = liftD D.getPermissions -{-# INLINE getPermissions #-} -- | The 'setPermissions' operation sets the permissions for the file or -- directory. @@ -1249,7 +1249,6 @@ setPermissions :: MonadIO m => Path b t -> D.Permissions -> m () setPermissions = liftD2' D.setPermissions -{-# INLINE setPermissions #-} -- | Set permissions for the object found on second given path so they match -- permissions of the object on the first path. @@ -1259,7 +1258,6 @@ -> Path b1 t1 -- ^ What to modify -> m () copyPermissions = liftD2 D.copyPermissions -{-# INLINE copyPermissions #-} ---------------------------------------------------------------------------- -- Timestamps @@ -1284,7 +1282,6 @@ getAccessTime :: MonadIO m => Path b t -> m UTCTime getAccessTime = liftD D.getAccessTime -{-# INLINE getAccessTime #-} -- | Change the time at which the file or directory was last accessed. -- @@ -1313,7 +1310,6 @@ setAccessTime :: MonadIO m => Path b t -> UTCTime -> m () setAccessTime = liftD2' D.setAccessTime -{-# INLINE setAccessTime #-} -- | Change the time at which the file or directory was last modified. -- @@ -1342,7 +1338,6 @@ setModificationTime :: MonadIO m => Path b t -> UTCTime -> m () setModificationTime = liftD2' D.setModificationTime -{-# INLINE setModificationTime #-} #endif -- | Obtain the time at which the file or directory was last modified. @@ -1360,7 +1355,6 @@ getModificationTime :: MonadIO m => Path b t -> m UTCTime getModificationTime = liftD D.getModificationTime -{-# INLINE getModificationTime #-} ---------------------------------------------------------------------------- -- Helpers @@ -1396,10 +1390,10 @@ liftD2' m a v = liftIO $ m (toFilePath a) v {-# INLINE liftD2' #-} --- | Perform specified action ignoring IO exceptions it may throw. +-- | Perform an action ignoring IO exceptions it may throw. -ignoringIOErrors :: MonadCatch m => m () -> m () +ignoringIOErrors :: IO () -> IO () ignoringIOErrors ioe = ioe `catch` handler where - handler :: MonadThrow m => IOError -> m () + handler :: Monad m => IOError -> m () handler = const (return ()) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-io-1.2.2/README.md new/path-io-1.3.3/README.md --- old/path-io-1.2.2/README.md 2017-01-01 12:40:32.000000000 +0100 +++ new/path-io-1.3.3/README.md 2017-06-03 19:24:23.000000000 +0200 @@ -5,13 +5,14 @@ [](http://stackage.org/nightly/package/path-io) [](http://stackage.org/lts/package/path-io) [](https://travis-ci.org/mrkkrp/path-io) +[](https://ci.appveyor.com/project/mrkkrp/path-io/branch/master) [](https://coveralls.io/github/mrkkrp/path-io?branch=master) -This package provides interface to -[`directory`](https://hackage.haskell.org/package/directory) package for +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. +directories, working with temporary files/directories, etc. Consult Haddocks for usage, which should be trivial. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-io-1.2.2/path-io.cabal new/path-io-1.3.3/path-io.cabal --- old/path-io-1.2.2/path-io.cabal 2017-01-06 17:26:33.000000000 +0100 +++ new/path-io-1.3.3/path-io.cabal 2017-07-31 07:25:12.000000000 +0200 @@ -1,42 +1,11 @@ --- --- Cabal configuration for ‘path-io’. --- --- Copyright © 2016–2017 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: 1.2.2 -cabal-version: >= 1.10 +version: 1.3.3 +cabal-version: >= 1.18 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3 license-file: LICENSE.md -author: Mark Karpov <[email protected]> -maintainer: Mark Karpov <[email protected]> +author: Mark Karpov <[email protected]> +maintainer: Mark Karpov <[email protected]> homepage: https://github.com/mrkkrp/path-io bug-reports: https://github.com/mrkkrp/path-io/issues category: System, Filesystem @@ -55,11 +24,12 @@ build-depends: base >= 4.7 && < 5.0 , containers , directory >= 1.2.2 && < 1.4 + , dlist >= 0.8 && < 0.9 , exceptions >= 0.8 && < 0.9 , filepath >= 1.2 && < 1.5 - , path >= 0.5 && < 0.6 + , path >= 0.5 && < 0.7 , temporary >= 1.1 && < 1.3 - , time >= 1.4 && < 1.7 + , time >= 1.4 && < 1.9 , transformers >= 0.3 && < 0.6 , unix-compat exposed-modules: Path.IO @@ -78,10 +48,12 @@ else ghc-options: -O2 -Wall build-depends: base >= 4.7 && < 5.0 + , directory >= 1.2.2 && < 1.4 , exceptions >= 0.8 && < 0.9 , hspec >= 2.0 && < 3.0 - , path >= 0.5 && < 0.6 - , path-io >= 1.2.2 + , path >= 0.5 && < 0.7 + , path-io + , transformers >= 0.3 && < 0.6 , unix-compat default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-io-1.2.2/tests/Main.hs new/path-io-1.3.3/tests/Main.hs --- old/path-io-1.2.2/tests/Main.hs 2017-01-05 19:38:27.000000000 +0100 +++ new/path-io-1.3.3/tests/Main.hs 2017-06-03 19:24:23.000000000 +0200 @@ -1,35 +1,3 @@ --- --- Tests for ‘path-io’ package. --- --- Copyright © 2016–2017 Mark Karpov <[email protected]> --- --- 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. - {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} @@ -37,6 +5,7 @@ import Control.Monad import Control.Monad.Catch +import Control.Monad.IO.Class (MonadIO (..)) import Data.List (sort) import Path import Path.IO @@ -50,7 +19,10 @@ 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 "listDirRecur" listDirRecurSpec describe "listDirRecurWith" listDirRecurWithSpec @@ -58,15 +30,15 @@ describe "copyDirRecur" copyDirRecurSpec describe "copyDirRecur'" copyDirRecur'Spec describe "findFile" findFileSpec - -- This test may fail on windows as unix-compat does not implement - -- createSymbolicLink. -#ifndef mingw32_HOST_OS beforeWith populatedCyclicDir $ describe "listDirRecur Cyclic" listDirRecurCyclicSpec #endif describe "getCurrentDir" getCurrentDirSpec describe "setCurrentDir" setCurrentDirSpec describe "withCurrentDir" withCurrentDirSpec +#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 #if MIN_VERSION_directory(1,2,3) @@ -74,6 +46,7 @@ describe "getXdgDir Config" getXdgConfigDirSpec describe "getXdgDir Cache" getXdgCacheDirSpec #endif +#endif listDirSpec :: SpecWith (Path Abs Dir) listDirSpec = it "lists directory" $ \dir -> @@ -92,9 +65,9 @@ `shouldReturn` populatedDirRecurWith listDirRecurWith - :: (Path Abs Dir -> IO Bool) -- ^ Dir match predicate + :: (Path Abs Dir -> IO Bool) -- ^ Dir match predicate -> (Path Abs File -> IO Bool) -- ^ File match predicate - -> Path Abs Dir -- ^ Top dir to traverse + -> 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 @@ -102,10 +75,17 @@ f' <- filterM filePred f return (d', f') +-- 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)) + listDirRecurCyclicSpec :: SpecWith (Path Abs Dir) listDirRecurCyclicSpec = it "lists directory trees having traversal cycles" $ \dir -> - getDirStructure listDirRecur dir `shouldReturn` populatedCyclicDirStructure + getDirStructure listDirRecurCyclic dir + `shouldReturn` populatedCyclicDirStructure -- | 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 @@ -235,7 +215,7 @@ ---------------------------------------------------------------------------- -- Helpers --- | Create sandbox directory to model some situation in it and run some +-- | 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. @@ -250,11 +230,15 @@ populatedDir :: Path Abs Dir -> IO (Path Abs Dir) populatedDir root = do - let (dirs, files) = populatedDirStructure + let (_, files) = populatedDirStructure pdir = root </> $(mkRelDir "pdir") withinSandbox = (pdir </>) ensureDir pdir - forM_ dirs (ensureDir . withinSandbox) + 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 @@ -291,12 +275,12 @@ -- | 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 +-- 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) +-- a\/(b -> c), c\/(d -> a) +-- c\/(d -> a), a\/(b -> c) -- 2) Cycle with own ancestor - -- e/f/(g -> e) +-- e\/f\/(g -> e) populatedCyclicDirStructure :: ([Path Rel Dir], [Path Rel File]) populatedCyclicDirStructure = @@ -351,7 +335,8 @@ ( [ $(mkRelDir "a") , $(mkRelDir "b") ] - , [ $(mkRelFile "b/c/three.txt") + , [ $(mkRelFile "a/c/three.txt") -- via symbolic link + , $(mkRelFile "b/c/three.txt") , $(mkRelFile "one.txt") ] ) ++++++ path-io.cabal ++++++ --- /var/tmp/diff_new_pack.fpW20D/_old 2018-05-30 12:26:42.827502768 +0200 +++ /var/tmp/diff_new_pack.fpW20D/_new 2018-05-30 12:26:42.827502768 +0200 @@ -1,43 +1,12 @@ --- --- Cabal configuration for ‘path-io’. --- --- Copyright © 2016–2017 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: 1.2.2 -x-revision: 1 -cabal-version: >= 1.10 +version: 1.3.3 +x-revision: 3 +cabal-version: >= 1.18 +tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 license: BSD3 license-file: LICENSE.md -author: Mark Karpov <[email protected]> -maintainer: Mark Karpov <[email protected]> +author: Mark Karpov <[email protected]> +maintainer: Mark Karpov <[email protected]> homepage: https://github.com/mrkkrp/path-io bug-reports: https://github.com/mrkkrp/path-io/issues category: System, Filesystem @@ -56,10 +25,11 @@ build-depends: base >= 4.7 && < 5.0 , containers , directory >= 1.2.2 && < 1.4 - , exceptions >= 0.8 && < 0.9 + , dlist >= 0.8 && < 0.9 + , exceptions >= 0.8 && < 0.11 , filepath >= 1.2 && < 1.5 - , path >= 0.5 && < 0.6 - , temporary >= 1.1 && < 1.3 + , path >= 0.5 && < 0.7 + , temporary >= 1.1 && < 1.4 , time >= 1.4 && < 1.9 , transformers >= 0.3 && < 0.6 , unix-compat @@ -79,10 +49,12 @@ else ghc-options: -O2 -Wall build-depends: base >= 4.7 && < 5.0 - , exceptions >= 0.8 && < 0.9 + , directory >= 1.2.2 && < 1.4 + , exceptions >= 0.8 && < 0.11 , hspec >= 2.0 && < 3.0 - , path >= 0.5 && < 0.6 - , path-io >= 1.2.2 + , path >= 0.5 && < 0.7 + , path-io + , transformers >= 0.3 && < 0.6 , unix-compat default-language: Haskell2010
