summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormrkkrp <>2020-10-17 14:50:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-10-17 14:50:00 (GMT)
commitce0a4122676949afd0a42eca52e55f9a941da775 (patch)
tree1b5ab82c8e1006f9593b89cc21c28884aa3ceade
parente8ebb22257a7b0d79bac08b649a3f44a645d52fb (diff)
version 1.6.11.6.1
-rw-r--r--CHANGELOG.md5
-rw-r--r--Path/IO.hs1070
-rw-r--r--README.md3
-rw-r--r--path-io.cabal129
-rw-r--r--tests/Main.hs225
5 files changed, 761 insertions, 671 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 9195b00..9a5e953 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,8 @@
+## Path IO 1.6.1
+
+* Fixed a space leak in `walkDirAccum`. [Issue
+ 55](https://github.com/mrkkrp/path-io/issues/55).
+
## Path IO 1.6.0
* Changed how `copyDirRecur` and `copyDirRecur'` functions work. Previously,
diff --git a/Path/IO.hs b/Path/IO.hs
index 3e40a66..c37cd2c 100644
--- a/Path/IO.hs
+++ b/Path/IO.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
+
-- |
-- Module : Path.IO
-- Copyright : © 2016–present Mark Karpov
@@ -11,98 +16,103 @@
-- "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'
+ createDir,
+ createDirIfMissing,
+ ensureDir,
+ removeDir,
+ removeDirRecur,
+ renameDir,
+ listDir,
+ listDirRel,
+ listDirRecur,
+ listDirRecurRel,
+ copyDirRecur,
+ copyDirRecur',
+
-- ** Walking directory trees
- , WalkAction (..)
- , walkDir
- , walkDirRel
- , walkDirAccum
- , walkDirAccumRel
+ WalkAction (..),
+ walkDir,
+ walkDirRel,
+ walkDirAccum,
+ walkDirAccumRel,
+
-- ** Current working directory
- , getCurrentDir
- , setCurrentDir
- , withCurrentDir
+ getCurrentDir,
+ setCurrentDir,
+ withCurrentDir,
+
-- * Pre-defined directories
- , getHomeDir
- , getAppUserDataDir
- , getUserDocsDir
- , getTempDir
- , D.XdgDirectory (..)
- , getXdgDir
- , D.XdgDirectoryList (..)
- , getXdgDirList
+ getHomeDir,
+ getAppUserDataDir,
+ getUserDocsDir,
+ getTempDir,
+ D.XdgDirectory (..),
+ getXdgDir,
+ D.XdgDirectoryList (..),
+ getXdgDirList,
+
-- * Path transformation
- , AnyPath (..)
- , resolveFile
- , resolveFile'
- , resolveDir
- , resolveDir'
+ AnyPath (..),
+ resolveFile,
+ resolveFile',
+ resolveDir,
+ resolveDir',
+
-- * Actions on files
- , removeFile
- , renameFile
- , copyFile
- , findExecutable
- , findFile
- , findFiles
- , findFilesWith
+ removeFile,
+ renameFile,
+ copyFile,
+ findExecutable,
+ findFile,
+ findFiles,
+ findFilesWith,
+
-- * Symbolic links
- , createFileLink
- , createDirLink
- , removeDirLink
- , getSymlinkTarget
- , isSymlink
+ createFileLink,
+ createDirLink,
+ removeDirLink,
+ getSymlinkTarget,
+ isSymlink,
+
-- * Temporary files and directories
- , withTempFile
- , withTempDir
- , withSystemTempFile
- , withSystemTempDir
- , openTempFile
- , openBinaryTempFile
- , createTempDir
+ withTempFile,
+ withTempDir,
+ withSystemTempFile,
+ withSystemTempDir,
+ openTempFile,
+ openBinaryTempFile,
+ createTempDir,
+
-- * Existence tests
- , doesFileExist
- , doesDirExist
- , isLocationOccupied
- , forgivingAbsence
- , ignoringAbsence
+ 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
+ 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 )
+ getAccessTime,
+ setAccessTime,
+ setModificationTime,
+ getModificationTime,
+ )
where
import Control.Arrow ((***))
@@ -111,19 +121,19 @@ 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 Control.Monad.Trans.Writer.Strict (WriterT, execWriterT, tell)
+import qualified Data.DList as DList
import Data.Either (lefts, rights)
import Data.Kind (Type)
import Data.List ((\\))
+import qualified Data.Set as S
import Data.Time (UTCTime)
import Path
+import qualified System.Directory as D
+import qualified System.FilePath as F
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.IO.Temp as T
import qualified System.PosixCompat.Files as P
----------------------------------------------------------------------------
@@ -161,18 +171,19 @@ import qualified System.PosixCompat.Files as P
-- * '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 ::
+ MonadIO m =>
+ -- | Create its parents too?
+ Bool ->
+ -- | The path to the directory you want to make
+ Path b Dir ->
+ m ()
createDirIfMissing p = liftD (D.createDirectoryIfMissing p)
-- | Ensure that a directory exists creating it and its parent directories
@@ -181,7 +192,6 @@ createDirIfMissing p = liftD (D.createDirectoryIfMissing p)
-- > ensureDir = createDirIfMissing True
--
-- @since 0.3.1
-
ensureDir :: MonadIO m => Path b Dir -> m ()
ensureDir = createDirIfMissing True
@@ -222,67 +232,67 @@ ensureDir = createDirIfMissing True
-- * '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' 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 =>
+ -- | Old name
+ Path b0 Dir ->
+ -- | New name
+ Path b1 Dir ->
+ m ()
renameDir = liftD2 D.renameDirectory
-- | @'listDir' dir@ returns a list of /all/ entries in @dir@ without the
@@ -313,30 +323,35 @@ renameDir = liftD2 D.renameDirectory
-- * '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 ::
+ MonadIO m =>
+ -- | Directory to list
+ Path b Dir ->
+ -- | Sub-directories and files
+ m ([Path Abs Dir], [Path Abs File])
listDir path = do
bpath <- makeAbsolute path
(subdirs, files) <- listDirRel bpath
- return ( (bpath </>) <$> subdirs
- , (bpath </>) <$> files
- )
+ 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 ::
+ MonadIO m =>
+ -- | Directory to list
+ Path b Dir ->
+ -- | Sub-directories and files
+ m ([Path Rel Dir], [Path Rel File])
listDirRel path = liftIO $ do
- raw <- liftD D.getDirectoryContents path
+ raw <- liftD D.getDirectoryContents path
items <- forM (raw \\ [".", ".."]) $ \item -> do
isDir <- liftIO (D.doesDirectoryExist $ toFilePath path F.</> item)
if isDir
- then Left <$> parseRelDir item
+ then Left <$> parseRelDir item
else Right <$> parseRelFile item
return (lefts items, rights items)
@@ -345,37 +360,45 @@ listDirRel path = liftIO $ do
-- 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
+listDirRecur ::
+ MonadIO m =>
+ -- | Directory to list
+ Path b Dir ->
+ -- | Sub-directories and files
+ m ([Path Abs Dir], [Path Abs File])
+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
- )
+ 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
+listDirRecurRel ::
+ MonadIO m =>
+ -- | Directory to list
+ Path b Dir ->
+ -- | Sub-directories and files
+ m ([Path Rel Dir], [Path Rel File])
+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)
- )
+ 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
@@ -393,11 +416,13 @@ listDirRecurRel dir = (DList.toList *** DList.toList)
-- /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 ::
+ (MonadIO m, MonadCatch m) =>
+ -- | Source
+ Path b0 Dir ->
+ -- | Destination
+ Path b1 Dir ->
+ m ()
copyDirRecur = copyDirRecurGen True
-- | The same as 'copyDirRecur', but it /does not/ preserve directory
@@ -416,33 +441,39 @@ copyDirRecur = copyDirRecurGen True
-- /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' ::
+ (MonadIO m, MonadCatch m) =>
+ -- | Source
+ Path b0 Dir ->
+ -- | Destination
+ Path b1 Dir ->
+ 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 ::
+ MonadIO m =>
+ -- | Should we preserve directory permissions?
+ Bool ->
+ -- | Source
+ Path b0 Dir ->
+ -- | Destination
+ Path b1 Dir ->
+ m ()
copyDirRecurGen preserveDirPermissions src dest = liftIO $ do
- bsrc <- makeAbsolute src
+ 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
+ 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
@@ -477,8 +508,8 @@ copyDirRecurGen preserveDirPermissions src dest = liftIO $ do
-- 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.
+-- - 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
@@ -506,11 +537,12 @@ copyDirRecurGen preserveDirPermissions src dest = liftIO $ do
-- 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
+ = -- | Finish the entire walk altogether
+ WalkFinish
+ | -- | List of sub-directories to exclude from
+ -- descending
+ WalkExclude [Path b Dir]
deriving (Eq, Show)
-- | Traverse a directory tree using depth first pre-order traversal,
@@ -523,16 +555,16 @@ data WalkAction b
-- 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
+walkDir ::
+ MonadIO m =>
+ -- | Handler (@dir -> subdirs -> files -> 'WalkAction'@)
+ (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m (WalkAction Abs)) ->
+ -- | Directory where traversal begins
+ Path b Dir ->
+ m ()
+walkDir handler topdir =
+ void $
+ makeAbsolute topdir >>= walkAvoidLoop S.empty
where
walkAvoidLoop traversed curdir = do
mRes <- checkLoop traversed curdir
@@ -547,33 +579,35 @@ walkDir handler topdir = void $
WalkExclude xdirs ->
case subdirs \\ xdirs of
[] -> return $ Just ()
- ds -> runMaybeT $ mapM_
- (MaybeT . walkAvoidLoop traversed)
- ds
+ 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)
+ 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 ::
+ MonadIO m =>
+ -- | Handler (@dir -> subdirs -> files -> 'WalkAction'@)
+ ( Path Rel Dir ->
+ [Path Rel Dir] ->
+ [Path Rel File] ->
+ m (WalkAction Rel)
+ ) ->
+ -- | Directory where traversal begins
+ Path b Dir ->
+ m ()
walkDirRel handler topdir' = do
topdir <- makeAbsolute topdir'
let walkAvoidLoop traversed curdir = do
@@ -589,15 +623,18 @@ walkDirRel handler topdir' = do
WalkExclude xdirs ->
case subdirs \\ xdirs of
[] -> return $ Just ()
- ds -> runMaybeT $ mapM_
- (MaybeT . walkAvoidLoop traversed)
- ((curdir </>) <$> ds)
+ 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)
+ 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
@@ -609,19 +646,18 @@ walkDirRel handler topdir' = do
-- 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 ::
+ (MonadIO m, Monoid o) =>
+ -- | Descend handler (@dir -> subdirs -> files -> 'WalkAction'@),
+ -- descend the whole tree if omitted
+ Maybe
+ (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m (WalkAction Abs)) ->
+ -- | Output writer (@dir -> subdirs -> files -> o@)
+ (Path Abs Dir -> [Path Abs Dir] -> [Path Abs File] -> m o) ->
+ -- | Directory where traversal begins
+ Path b Dir ->
+ -- | Accumulation of outputs generated by the output writer invocations
+ m o
walkDirAccum = walkDirAccumWith walkDir
-- | The same as 'walkDirAccum' but uses relative paths. The handler and
@@ -629,43 +665,41 @@ walkDirAccum = walkDirAccumWith walkDir
-- 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 ::
+ (MonadIO m, Monoid o) =>
+ -- | Descend handler (@dir -> subdirs -> files -> 'WalkAction'@),
+ -- descend the whole tree if omitted
+ Maybe
+ (Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)) ->
+ -- | Output writer (@dir -> subdirs -> files -> o@)
+ (Path Rel Dir -> [Path Rel Dir] -> [Path Rel File] -> m o) ->
+ -- | Directory where traversal begins
+ Path b Dir ->
+ -- | Accumulation of outputs generated by the output writer invocations
+ m o
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 ::
+ (MonadIO m, Monoid o) =>
+ -- | The walk function we use
+ ( ( Path a Dir ->
+ [Path a Dir] ->
+ [Path a File] ->
+ WriterT o m (WalkAction a)
+ ) ->
+ Path b Dir ->
+ WriterT o m ()
+ ) ->
+ -- | Descend handler (@dir -> subdirs -> files -> 'WalkAction'@),
+ -- descend the whole tree if omitted
+ Maybe (Path a Dir -> [Path a Dir] -> [Path a File] -> m (WalkAction a)) ->
+ -- | Output writer (@dir -> subdirs -> files -> o@)
+ (Path a Dir -> [Path a Dir] -> [Path a File] -> m o) ->
+ -- | Directory where traversal begins
+ Path b Dir ->
+ -- | Accumulation of outputs generated by the output writer invocations
+ m o
walkDirAccumWith walkF dHandler writer topdir =
execWriterT (walkF handler topdir)
where
@@ -705,7 +739,6 @@ walkDirAccumWith walkF dHandler writer topdir =
--
-- * 'UnsupportedOperation'
-- The operating system has no notion of current working directory.
-
getCurrentDir :: MonadIO m => m (Path Abs Dir)
getCurrentDir = liftIO $ D.getCurrentDirectory >>= parseAbsDir
@@ -741,7 +774,6 @@ getCurrentDir = liftIO $ D.getCurrentDirectory >>= parseAbsDir
-- * 'InappropriateType'
-- The path refers to an existing non-directory object.
-- @[ENOTDIR]@
-
setCurrentDir :: MonadIO m => Path b Dir -> m ()
setCurrentDir = liftD D.setCurrentDirectory
@@ -751,11 +783,13 @@ setCurrentDir = liftD D.setCurrentDirectory
--
-- 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 ::
+ (MonadIO m, MonadMask m) =>
+ -- | Directory to execute in
+ Path b Dir ->
+ -- | Action to be executed
+ m a ->
+ m a
withCurrentDir dir action =
bracket getCurrentDir setCurrentDir $ const (setCurrentDir dir >> action)
@@ -780,7 +814,6 @@ withCurrentDir dir action =
-- * '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'
@@ -807,10 +840,11 @@ getHomeDir = liftIO D.getHomeDirectory >>= resolveDir'
-- * '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 ::
+ MonadIO m =>
+ -- | Name of application (used in path construction)
+ String ->
+ m (Path Abs Dir)
getAppUserDataDir = liftIO . (>>= parseAbsDir) . D.getAppUserDataDirectory
-- | Return the current user's document directory.
@@ -831,7 +865,6 @@ getAppUserDataDir = liftIO . (>>= parseAbsDir) . D.getAppUserDataDirectory
-- * '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
@@ -860,7 +893,6 @@ getUserDocsDir = liftIO $ D.getUserDocumentsDirectory >>= parseAbsDir
-- 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'
@@ -880,13 +912,14 @@ getTempDir = liftIO D.getTemporaryDirectory >>= resolveDir'
-- @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 ::
+ MonadIO m =>
+ -- | Which special directory
+ D.XdgDirectory ->
+ -- | A relative path that is appended to the path; if 'Nothing', the
+ -- base path is returned
+ Maybe (Path Rel Dir) ->
+ m (Path Abs Dir)
getXdgDir xdgDir suffix =
liftIO $ (D.getXdgDirectory xdgDir $ maybe "" toFilePath suffix) >>= parseAbsDir
@@ -899,11 +932,11 @@ getXdgDir xdgDir suffix =
-- 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 ::
+ MonadIO m =>
+ -- | Which special directory list
+ D.XdgDirectoryList ->
+ m [Path Abs Dir]
getXdgDirList xdgDirList =
liftIO (D.getXdgDirectoryList xdgDirList >>= mapM parseAbsDir)
@@ -912,15 +945,11 @@ getXdgDirList xdgDirList =
-- | 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
@@ -951,55 +980,55 @@ class AnyPath path where
--
-- 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)
+ 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)
+ 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)
+ makeRelative ::
+ MonadThrow m =>
+ -- | Base directory
+ Path Abs Dir ->
+ -- | Path that will be made relative to base directory
+ path ->
+ m (RelPath path)
-- | Make a path relative to current working directory.
--
-- @since 0.3.0
-
- makeRelativeToCurrentDir :: MonadIO m
- => path
- -> m (RelPath path)
+ 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
+ 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
+ makeAbsolute = liftD D.makeAbsolute >=> liftIO . parseAbsDir
makeRelative b p = parseRelDir (F.makeRelative (toFilePath b) (toFilePath p))
makeRelativeToCurrentDir p = liftIO $ getCurrentDir >>= flip makeRelative p
@@ -1007,39 +1036,45 @@ instance AnyPath (Path b Dir) where
-- it.
--
-- @since 0.3.0
-
-resolveFile :: MonadIO m
- => Path Abs Dir -- ^ Base directory
- -> FilePath -- ^ Path to resolve
- -> m (Path Abs File)
+resolveFile ::
+ MonadIO m =>
+ -- | Base directory
+ Path Abs Dir ->
+ -- | Path to resolve
+ FilePath ->
+ 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' ::
+ MonadIO m =>
+ -- | Path to resolve
+ FilePath ->
+ 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 ::
+ MonadIO m =>
+ -- | Base directory
+ Path Abs Dir ->
+ -- | Path to resolve
+ FilePath ->
+ 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' ::
+ MonadIO m =>
+ -- | Path to resolve
+ FilePath ->
+ m (Path Abs Dir)
resolveDir' p = getCurrentDir >>= flip resolveDir p
----------------------------------------------------------------------------
@@ -1075,7 +1110,6 @@ resolveDir' p = getCurrentDir >>= flip resolveDir p
-- * 'InappropriateType'
-- The operand refers to an existing directory.
-- @[EPERM, EINVAL]@
-
removeFile :: MonadIO m => Path b File -> m ()
removeFile = liftD D.removeFile
@@ -1119,22 +1153,26 @@ removeFile = liftD D.removeFile
-- * '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 ::
+ MonadIO m =>
+ -- | Original location
+ Path b0 File ->
+ -- | New location
+ Path b1 File ->
+ 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 ::
+ MonadIO m =>
+ -- | Original location
+ Path b0 File ->
+ -- | Where to put copy
+ Path b1 File ->
+ m ()
copyFile = liftD2 D.copyFile
-- | Given an executable file name, search for such file in the directories
@@ -1151,20 +1189,25 @@ copyFile = liftD2 D.copyFile
-- it actually searches depends on registry settings, but notably includes
-- the directory containing the current executable. See
-- <http://msdn.microsoft.com/en-us/library/aa365527.aspx> for more details.
-
-findExecutable :: MonadIO m
- => Path Rel File -- ^ Executable file name
- -> m (Maybe (Path Abs File)) -- ^ Path to found executable
+findExecutable ::
+ MonadIO m =>
+ -- | Executable file name
+ Path Rel File ->
+ -- | Path to found executable
+ m (Maybe (Path Abs File))
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 ::
+ MonadIO m =>
+ -- | Set of directories to search in
+ [Path b Dir] ->
+ -- | Filename of interest
+ Path Rel File ->
+ -- | Absolute path to file (if found)
+ m (Maybe (Path Abs File))
findFile [] _ = return Nothing
-findFile (d:ds) file = do
+findFile (d : ds) file = do
bfile <- (</> file) <$> makeAbsolute d
exist <- doesFileExist bfile
if exist
@@ -1173,29 +1216,36 @@ findFile (d:ds) file = do
-- | 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 ::
+ MonadIO m =>
+ -- | Set of directories to search in
+ [Path b Dir] ->
+ -- | Filename of interest
+ Path Rel File ->
+ -- | Absolute paths to all found files
+ m [Path Abs File]
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 ::
+ MonadIO m =>
+ -- | How to test the files
+ (Path Abs File -> m Bool) ->
+ -- | Set of directories to search in
+ [Path b Dir] ->
+ -- | Filename of interest
+ Path Rel File ->
+ -- | Absolute paths to all found files
+ m [Path Abs File]
findFilesWith _ [] _ = return []
-findFilesWith f (d:ds) file = do
+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
+ then (bfile :) <$> findFilesWith f ds file
else findFilesWith f ds file
----------------------------------------------------------------------------
@@ -1228,12 +1278,13 @@ findFilesWith f (d:ds) file = do
-- 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 ::
+ MonadIO m =>
+ -- | Path to the target file
+ Path b0 File ->
+ -- | Path to the link to be created
+ Path b1 File ->
+ m ()
createFileLink = liftD2 D.createFileLink
-- | Create a /directory/ symbolic link. The target path can be either
@@ -1264,12 +1315,13 @@ createFileLink = liftD2 D.createFileLink
-- 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 ::
+ MonadIO m =>
+ -- | Path to the target directory
+ Path b0 Dir ->
+ -- | Path to the link to be created
+ Path b1 Dir ->
+ m ()
createDirLink target' dest' = do
let target = toFilePath target'
dest = F.dropTrailingPathSeparator (toFilePath dest')
@@ -1283,11 +1335,11 @@ createDirLink target' dest' = do
-- 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 ::
+ MonadIO m =>
+ -- | Path to the link to be removed
+ Path b Dir ->
+ m ()
removeDirLink = liftD D.removeDirectoryLink
-- | Retrieve the target path of either a file or directory symbolic link.
@@ -1302,11 +1354,11 @@ removeDirLink = liftD D.removeDirectoryLink
-- support symbolic links.
--
-- @since 1.5.0
-
-getSymlinkTarget
- :: MonadIO m
- => Path b t -- ^ Symlink path
- -> m FilePath
+getSymlinkTarget ::
+ MonadIO m =>
+ -- | Symlink path
+ Path b t ->
+ m FilePath
getSymlinkTarget = liftD (D.getSymbolicLinkTarget . F.dropTrailingPathSeparator)
-- | Check whether the path refers to a symbolic link. An exception is thrown
@@ -1321,7 +1373,6 @@ getSymlinkTarget = liftD (D.getSymbolicLinkTarget . F.dropTrailingPathSeparator)
-- | 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)
@@ -1334,12 +1385,15 @@ isSymlink = liftD (D.pathIsSymbolicLink . F.dropTrailingPathSeparator)
-- 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 ::
+ (MonadIO m, MonadMask m) =>
+ -- | Directory to create the file in
+ Path b Dir ->
+ -- | File name template, see 'openTempFile'
+ String ->
+ -- | Callback that can use the file
+ (Path Abs File -> Handle -> m a) ->
+ m a
withTempFile path t action = do
apath <- makeAbsolute path
T.withTempFile (toFilePath apath) t $ \file h ->
@@ -1351,12 +1405,15 @@ withTempFile path t action = do
-- 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 ::
+ (MonadIO m, MonadMask m) =>
+ -- | Directory to create the file in
+ Path b Dir ->
+ -- | Directory name template, see 'openTempFile'
+ String ->
+ -- | Callback that can use the directory
+ (Path Abs Dir -> m a) ->
+ m a
withTempDir path t action = do
apath <- makeAbsolute path
T.withTempDirectory (toFilePath apath) t (parseAbsDir >=> action)
@@ -1368,13 +1425,16 @@ withTempDir path t action = do
-- 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
+withSystemTempFile ::
+ (MonadIO m, MonadMask m) =>
+ -- | File name template, see 'openTempFile'
+ String ->
+ -- | Callback that can use the file
+ (Path Abs File -> Handle -> m a) ->
+ m a
+withSystemTempFile t action =
+ getTempDir >>= \path ->
+ withTempFile path t action
-- | Create and use a temporary directory in the system standard temporary
-- directory.
@@ -1383,13 +1443,16 @@ withSystemTempFile t action = getTempDir >>= \path ->
-- 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
+withSystemTempDir ::
+ (MonadIO m, MonadMask m) =>
+ -- | Directory name template, see 'openTempFile'
+ String ->
+ -- | Callback that can use the directory
+ (Path Abs Dir -> m a) ->
+ 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.
@@ -1407,13 +1470,15 @@ withSystemTempDir t action = getTempDir >>= \path ->
-- 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 ::
+ MonadIO m =>
+ -- | Directory to create file in
+ Path b Dir ->
+ -- | File name template; if the template is "foo.ext" then the created
+ -- file will be @\"fooXXX.ext\"@ where @XXX@ is some random number
+ String ->
+ -- | Name of created file and its 'Handle'
+ m (Path Abs File, Handle)
openTempFile path t = liftIO $ do
apath <- makeAbsolute path
(tfile, h) <- liftD2' T.openTempFile apath t
@@ -1428,11 +1493,14 @@ openTempFile path t = liftIO $ do
-- 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 ::
+ MonadIO m =>
+ -- | Directory to create file in
+ Path b Dir ->
+ -- | File name template, see 'openTempFile'
+ String ->
+ -- | Name of created file and its 'Handle'
+ m (Path Abs File, Handle)
openBinaryTempFile path t = liftIO $ do
apath <- makeAbsolute path
(tfile, h) <- liftD2' T.openBinaryTempFile apath t
@@ -1445,37 +1513,39 @@ openBinaryTempFile path t = liftIO $ do
-- 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
+createTempDir ::
+ MonadIO m =>
+ -- | Directory to create file in
+ Path b Dir ->
+ -- | Directory name template, see 'openTempFile'
+ String ->
+ -- | Name of created temporary directory
+ m (Path Abs Dir)
+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)
+ dir <- liftIO (D.doesDirectoryExist fp)
return (file || dir)
-- | If argument of the function throws a
@@ -1483,16 +1553,16 @@ isLocationOccupied path = do
-- 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)
+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
@@ -1508,7 +1578,6 @@ ignoringAbsence = void . forgivingAbsence
-- 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
@@ -1521,17 +1590,18 @@ getPermissions = liftD D.getPermissions
-- 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 ::
+ MonadIO m =>
+ -- | From where to copy
+ Path b0 t0 ->
+ -- | What to modify
+ Path b1 t1 ->
+ m ()
copyPermissions = liftD2 D.copyPermissions
----------------------------------------------------------------------------
@@ -1552,7 +1622,6 @@ copyPermissions = liftD2 D.copyPermissions
--
-- 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
@@ -1580,7 +1649,6 @@ getAccessTime = liftD D.getAccessTime
--
-- 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
@@ -1608,7 +1676,6 @@ setAccessTime = liftD2' D.setAccessTime
--
-- 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
@@ -1624,7 +1691,6 @@ setModificationTime = liftD2' D.setModificationTime
-- 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
@@ -1633,37 +1699,45 @@ getModificationTime = liftD D.getModificationTime
-- | 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 ::
+ MonadIO m =>
+ -- | Original action
+ (FilePath -> IO a) ->
+ -- | 'Path' argument
+ Path b t ->
+ -- | Lifted action
+ m a
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 ::
+ MonadIO m =>
+ -- | Original action
+ (FilePath -> FilePath -> IO a) ->
+ -- | First 'Path' argument
+ Path b0 t0 ->
+ -- | Second 'Path' argument
+ Path b1 t1 ->
+ 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' ::
+ MonadIO m =>
+ -- | Original action
+ (FilePath -> v -> IO a) ->
+ -- | First 'Path' argument
+ Path b t ->
+ -- | Second argument
+ v ->
+ 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
diff --git a/README.md b/README.md
index 6237ce6..0b7375e 100644
--- a/README.md
+++ b/README.md
@@ -4,8 +4,7 @@
[![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)
+![CI](https://github.com/mrkkrp/path-io/workflows/CI/badge.svg?branch=master)
This package provides an interface to the
[`directory`](https://hackage.haskell.org/package/directory) package for
diff --git a/path-io.cabal b/path-io.cabal
index dad4b89..bf5759a 100644
--- a/path-io.cabal
+++ b/path-io.cabal
@@ -1,68 +1,75 @@
-name: 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 <markkarpov92@gmail.com>
-maintainer: Mark Karpov <markkarpov92@gmail.com>
-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
+cabal-version: 1.18
+name: path-io
+version: 1.6.1
+license: BSD3
+license-file: LICENSE.md
+maintainer: Mark Karpov <markkarpov92@gmail.com>
+author: Mark Karpov <markkarpov92@gmail.com>
+tested-with: ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.2
+homepage: https://github.com/mrkkrp/path-io
+bug-reports: https://github.com/mrkkrp/path-io/issues
+synopsis: Interface to ‘directory’ package for users of ‘path’
+description: Interface to ‘directory’ package for users of ‘path’.
+category: System, Filesystem
+build-type: Simple
+extra-doc-files:
+ CHANGELOG.md
+ README.md
+
+source-repository head
+ type: git
+ location: https://github.com/mrkkrp/path-io.git
flag dev
- description: Turn on development settings.
- manual: True
- default: False
+ description: Turn on development settings.
+ default: False
+ manual: True
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
+ exposed-modules: Path.IO
+ default-language: Haskell2010
+ build-depends:
+ base >=4.12 && <5.0,
+ containers -any,
+ directory >=1.3.2.0 && <1.4,
+ dlist >=0.8 && <2.0,
+ exceptions >=0.8 && <0.11,
+ filepath >=1.2 && <1.5,
+ path >=0.6 && <0.9,
+ temporary >=1.1 && <1.4,
+ time >=1.4 && <1.11,
+ transformers >=0.3 && <0.6,
+ unix-compat -any
+
+ 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
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
+ type: exitcode-stdio-1.0
+ main-is: Main.hs
+ hs-source-dirs: tests
+ default-language: Haskell2010
+ build-depends:
+ base >=4.12 && <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.9,
+ path-io -any,
+ transformers >=0.3 && <0.6,
+ unix-compat -any
-source-repository head
- type: git
- location: https://github.com/mrkkrp/path-io.git
+ if flag(dev)
+ ghc-options: -Wall -Werror
+
+ else
+ ghc-options: -O2 -Wall
diff --git a/tests/Main.hs b/tests/Main.hs
index cdeadb7..ec917cc 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Main (main) where
@@ -32,10 +32,11 @@ main = hspec . around withSandbox $ do
beforeWith populatedCyclicDir $
describe "listDirRecur Cyclic" listDirRecurCyclicSpec
#endif
- describe "getCurrentDir" getCurrentDirSpec
- describe "setCurrentDir" setCurrentDirSpec
- describe "withCurrentDir" withCurrentDirSpec
- describe "walkDirRel" walkDirRelSpec
+ 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.
@@ -65,19 +66,26 @@ listDirRecurRelSpec = it "lists directory recursively" $ \dir ->
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
+ getDirStructure
+ ( listDirRecurWith
+ (return . ($(mkRelDir "c") /=) . dirname)
+ (return . ($(mkRelFile "two.txt") /=) . filename)
+ )
+ dir
+ `shouldReturn` populatedDirRecurWith
+
+listDirRecurWith ::
+ -- | Dir match predicate
+ (Path Abs Dir -> IO Bool) ->
+ -- | File match predicate
+ (Path Abs File -> IO Bool) ->
+ -- | Top dir to traverse
+ Path Abs Dir ->
+ -- | Matched subdirs and files
+ IO ([Path Abs Dir], [Path Abs File])
listDirRecurWith dirPred filePred =
walkDirAccum Nothing $ \_ d f -> do
- d' <- filterM dirPred d
+ d' <- filterM dirPred d
f' <- filterM filePred f
return (d', f')
@@ -85,50 +93,49 @@ listDirRecurWith dirPred filePred =
-- 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)
+ 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
+ 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
+ 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 }
+ 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
@@ -140,12 +147,15 @@ listDirRecurCyclicSpec :: SpecWith (Path Abs Dir)
listDirRecurCyclicSpec =
it "lists directory trees having traversal cycles" $ \dir ->
getDirStructure listDirRecurCyclic dir
- `shouldReturn` populatedCyclicDirStructure
+ `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 ::
+ (MonadIO m, MonadThrow m) =>
+ -- | Directory to list
+ Path b Dir ->
+ -- | Sub-directories and files
+ m ([Path Abs Dir], [Path Abs File])
listDirRecurCyclic = walkDirAccum Nothing (\_ d f -> return (d, f))
getCurrentDirSpec :: SpecWith (Path Abs Dir)
@@ -156,7 +166,7 @@ setCurrentDirSpec :: SpecWith (Path Abs Dir)
setCurrentDirSpec = it "sets current dir" $ \dir -> do
wdir <- getCurrentDir
setCurrentDir dir
- new <- getCurrentDir
+ new <- getCurrentDir
setCurrentDir wdir
new `shouldBe` dir
@@ -181,16 +191,18 @@ getHomeDirSpec =
bracket (getEnv evar) (setEnv evar) $ \_ -> do
setEnv evar (toFilePath dir)
getHomeDir `shouldReturn` dir
- where evar = "HOME"
+ where
+ evar = "HOME"
getTempDirSpec :: SpecWith (Path Abs Dir)
getTempDirSpec =
it "temp dir is influenced by environment variable TMPDIR" $ \dir ->
- flip finally (unsetEnv evar) $ do
+ flip finally (unsetEnv evar) $ do
setEnv evar (toFilePath dir)
getTempDir `shouldReturn` dir
unsetEnv evar
- where evar = "TMPDIR"
+ where
+ evar = "TMPDIR"
getXdgDataDirSpec :: SpecWith (Path Abs Dir)
getXdgDataDirSpec =
@@ -200,8 +212,9 @@ getXdgDataDirSpec =
getXdgDir XdgData (Just name) `shouldReturn` (dir </> name)
getXdgDir XdgData Nothing `shouldReturn` dir
unsetEnv evar
- where evar = "XDG_DATA_HOME"
- name = $(mkRelDir "test")
+ where
+ evar = "XDG_DATA_HOME"
+ name = $(mkRelDir "test")
getXdgConfigDirSpec :: SpecWith (Path Abs Dir)
getXdgConfigDirSpec =
@@ -211,8 +224,9 @@ getXdgConfigDirSpec =
getXdgDir XdgConfig (Just name) `shouldReturn` (dir </> name)
getXdgDir XdgConfig Nothing `shouldReturn` dir
unsetEnv evar
- where evar = "XDG_CONFIG_HOME"
- name = $(mkRelDir "test")
+ where
+ evar = "XDG_CONFIG_HOME"
+ name = $(mkRelDir "test")
getXdgCacheDirSpec :: SpecWith (Path Abs Dir)
getXdgCacheDirSpec =
@@ -222,8 +236,9 @@ getXdgCacheDirSpec =
getXdgDir XdgCache (Just name) `shouldReturn` (dir </> name)
getXdgDir XdgCache Nothing `shouldReturn` dir
unsetEnv evar
- where evar = "XDG_CACHE_HOME"
- name = $(mkRelDir "test")
+ where
+ evar = "XDG_CACHE_HOME"
+ name = $(mkRelDir "test")
----------------------------------------------------------------------------
-- Helpers
@@ -232,7 +247,6 @@ getXdgCacheDirSpec =
-- 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"
@@ -240,11 +254,10 @@ withSandbox = withSystemTempDir "path-io-sandbox"
-- 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")
+ pdir = root </> $(mkRelDir "pdir")
withinSandbox = (pdir </>)
ensureDir pdir
ensureDir $ withinSandbox $(mkRelDir "b")
@@ -257,42 +270,39 @@ populatedDir root = do
-- | 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 ::
+ -- | Which function to use for scanning
+ (Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])) ->
+ -- | Path to directory to scan
+ Path Abs Dir ->
+ IO ([Path Rel Dir], [Path Rel File])
getDirStructure f path = do
(dirs, files) <- f path
- rdirs <- sort <$> mapM (makeRelative path) dirs
+ 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 ::
+ -- | Which function to use for scanning
+ (Path Abs Dir -> IO ([Path Rel Dir], [Path Rel File])) ->
+ -- | Path to directory to scan
+ Path Abs Dir ->
+ 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")
+ ( [ $(mkRelDir "a"),
+ $(mkRelDir "b"),
+ $(mkRelDir "b/c")
+ ],
+ [ $(mkRelFile "b/c/three.txt"),
+ $(mkRelFile "b/two.txt"),
+ $(mkRelFile "one.txt")
]
)
@@ -305,29 +315,26 @@ populatedDirStructure =
-- 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
- ]
- , []
+ ( [ $(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")
+ let pdir = root </> $(mkRelDir "pdir")
withinSandbox = (pdir </>)
ensureDir pdir
ensureDir $ withinSandbox $(mkRelDir "a")
@@ -340,27 +347,25 @@ populatedCyclicDir root = do
-- | 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")
+ ( [ $(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")
+ ( [ $(mkRelDir "a"),
+ $(mkRelDir "b")
+ ],
+ [ $(mkRelFile "a/c/three.txt"), -- via symbolic link
+ $(mkRelFile "b/c/three.txt"),
+ $(mkRelFile "one.txt")
]
)